标签 api 下的文章

Delphi 使用Windows API(WinCrypt)计算文件MD5哈希,支持大文件

Delphi_WinApi_GetFileHash4MD5.jpg/


Delphi 默认没有WinCrypt相关函数的定义所以引用JwaWinCrypt{jedi-apilib}单元

将 CryptCreateHash(hProv, CALG_MD5,0, 0, hHash)中的参数CALG_MD5

修改为CALG_SHA1即为计算SHA1哈希 值得注意的时CALG_SHA_256,CALG_SHA_384,CALG_SHA_512

着三个算法是在Windows XP SP3才开始支持的  XP SP2~ Win2000是不支持的!!


program Project2;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  System.Math,
  JwaWinCrypt;


Function GetFileSizeEx(hFile: THandle; Var lpFileSizeHigh :UInt64):Boolean; stdcall; external kernel32 name 'GetFileSizeEx';


Function GetFileHash4Md5(FileDirectory :PChar):String;
Const
  Buffer_Threshold = 1024 * 1024;
Label OnFail;
Var
  hFile      :THandle;
  hMapFile   :THandle;
  dwFileSize :UInt64;
  dwFileSizeH:DWORD;

  hProv      :HCRYPTPROV;
  hHash      :HCRYPTHASH;
  iIndex     :UInt64;
  dwBufSize  :DWORD;
  lpBuffer   :PByte;

  lpHash     :Array [0..MAXCHAR] Of Byte;
  dwHashLen  :DWORD;
  szHash     :Array [0..MAXCHAR] Of Char;
begin
  Writeln('文件:', FileDirectory);
  Result   := '';
  lpBuffer := Nil;
  hMapFile := INVALID_HANDLE_VALUE;
  hFile    := CreateFile(FileDirectory, GENERIC_READ, FILE_SHARE_READ, Nil,OPEN_EXISTING, 0, 0);
  if hFile = INVALID_HANDLE_VALUE then
  begin
    Writeln('CreateFile Error, ErrorCode:', GetLastError);
    Goto OnFail;
  end;

  if Not GetFileSizeEx(hFile, dwFileSize) then
  begin
    Writeln('GetFileSizeEx Error, ErrorCode:', GetLastError);
    Goto OnFail;
  end;
  Writeln('大小:', dwFileSize, ' 字节');

  hMapFile := CreateFileMapping(hFile, Nil, PAGE_READONLY, 0, 0, Nil);
  if hMapFile = INVALID_HANDLE_VALUE then
  begin
    Writeln('CreateFileMapping Error, ErrorCode:', GetLastError);
    Goto OnFail;
  end;

  if Not CryptAcquireContext(hProv, Nil, Nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT Or CRYPT_MACHINE_KEYSET) Then
  begin
    Writeln('CryptAcquireContext Error, ErrorCode:', GetLastError);
    Goto OnFail;
  end;

  if Not CryptCreateHash(hProv, CALG_MD5,0, 0, hHash) Then
  begin
    Writeln('CryptCreateHash Error, ErrorCode:', GetLastError);
    Goto OnFail;
  end;

  iIndex := 0;
  while iIndex < dwFileSize do
  begin
    dwBufSize := Min(dwFileSize - iIndex, Buffer_Threshold);
    lpBuffer  := MapViewOfFile(hMapFile, FILE_MAP_READ, Int64Rec(iIndex).Hi, Int64Rec(iIndex).Lo, dwBufSize);
    if lpBuffer = Nil then
    begin
      Writeln('MapViewOfFile Error, ErrorCode:', GetLastError);
      Goto OnFail;
    end;

    if Not CryptHashData(hHash, lpBuffer, dwBufSize, 0) then
    begin
      Writeln('CryptHashData Error, ErrorCode:', GetLastError);
      Goto OnFail;
    end;

    UnmapViewOfFile(lpBuffer);
    Inc(iIndex, Buffer_Threshold);
  end;

  dwBufSize := SizeOf(DWORD);
  dwHashLen := 0;
  if CryptGetHashParam(hHash, HP_HASHSIZE, @dwHashLen, dwBufSize, 0) then
  begin
    ZeroMemory(@lpHash, SizeOf(lpHash));
    if CryptGetHashParam(hHash, HP_HASHVAL, @lpHash, dwHashLen, 0) Then
    begin
      for dwFileSizeH := 0 to dwHashLen-1 do
      begin
        wsprintf(@szHash, '%s%02x', szHash, lpHash[dwFileSizeH]);
      end;
      Writeln('MD5:', String(szHash));
    end Else
    begin
      Writeln('Error getting hash value, ErrorCode:', GetLastError);
      Goto OnFail;
    end;  
  end Else
  begin
    Writeln('Error getting hash length value, ErrorCode:', GetLastError);
    Goto OnFail;
  end;

OnFail:
  CryptDestroyHash(hHash);
  CryptReleaseContext(hProv, 0);
  UnmapViewOfFile(lpBuffer);
  CloseHandle(hFile);
  CloseHandle(hMapFile);
end;


begin
  GetFileHash4Md5('E:\ISO\cn_windows_server_2016_updated_feb_2018_x64_dvd_11636703.iso');
  Readln;
end.


DLL与EXE之间的恩爱情仇

program Bin;
{$APPTYPE CONSOLE}

uses
  Windows;
  
Function RunApi(lpPorc :Pointer):Integer; Stdcall; external 'Test.Dll' name 'RunApi';

Var
  lpPorc :Pointer;
begin
  lpPorc := @MessageBoxW;// 这里可以自己动态加载需要的API
  RunApi(lpPorc);//传入API的内存地址
end.



library DLL;

Uses
  Windows;

Type
  TMyMessageBox = function(hWnd: HWND; lpText, lpCaption: LPCWSTR; uType: UINT): Integer; stdcall;

Function RunApi(lpPorc :Pointer):Integer;
Var
  pMessageBox :TMyMessageBox;
begin
  Result := -1;
  if Assigned(lpPorc) Then 
  begin
    pMessageBox := lpPorc;
    pMessageBox(0, 'Test', 'hahaha', 0);  //调用EXE传进来的API
    Result := 1;
  end;
end;

Exports
  RunApi;

begin
end.


通过以上代码可以在DLL中调用EXE中的API或函数

而DLL里只需要定义就行了

比如某Rat的EXE和DLL都带有通讯库这样会造成内存消耗的加大

以及DLL在动态传输时体积的增大

如果将EXE中的通讯库直接传入DLL然后由DLL直接调用进行操作体积可以减小很多


Delphi 简单实习窗体靠边隐藏

  private
    { Private declarations }
    Procedure OnMove(Var Message:TMessage);  Message WM_MOVE;
  public
    { Public declarations }
  end;


Procedure TForm_Main.OnMove(Var Message:TMessage);
begin
  If GetWindowRect(Form_Main.Handle, lpRect) And (Metrics.X > 0) And (Metrics.Y > 0) Then
  begin
    if lpRect.Left < 30 then
    begin
      Form_Main.Left := 0 - (Form_Main.Width - 10);  //左隐藏
    end Else
    if (Metrics.X - lpRect.Right) < 30 then
    begin
      Form_Main.Left := Metrics.X - 10;   //又隐藏
    end Else
    if lpRect.Top < 30 then
    begin
      Form_Main.Top := 0 - (Form_Main.Height - 10);  //上隐藏
    end Else
    if (Metrics.Y - lpRect.Bottom) < 30 then
    begin                                        //下隐藏
      Form_Main.Top := Metrics.Y - 60;
    end;
  end;
end;


PHP4Delphi 对PHP5.4.X支持的尝试修复

<p>

&nbsp; &nbsp;
PHP5.3.X的话 Delphi盒子论坛有人做了修改

</p>
<p>

&nbsp; &nbsp;
我是在他那个的基础上做修改的

</p>
<p>

&nbsp; &nbsp;
如果不是最近工程需求真不会去看这个代码..

</p>
<p>

&nbsp; &nbsp;
PHP5.4 把之前的php_body_write 修改成了&nbsp;php_output_write

</p>
<p>

&nbsp; &nbsp;
做向上升级兼容的话

</p>
<p>

<br />

</p>
<p>

&nbsp; &nbsp;
ZEND_BUILD_TS&nbsp;线程安全这里是一处要改的

</p>
<p>

&nbsp; &nbsp;
ZEND_MODULE_BUILD_ID 编译ID是一处

</p>
<p>

&nbsp; &nbsp;
ZEND_BUILD_SYSTEM 编译环境是一处{这个是指定是用VC6,9,11编译的}

</p>
<p>

&nbsp; &nbsp;
其他代码的话具体要看着改动了

</p>
<p>

&nbsp; &nbsp;
目前我测试PHP4Delphi的代码里至少需要有二十多个API需要做向上升级兼容

</p>
<p>

&nbsp; &nbsp;
比如 php_body_write&nbsp;需要修改成这样.. 貌似5.5.x 不支持xp跟2k3系统所以我暂时不会去看

</p>

{$IFDEF PHP540}
  php_output_write(Memory, Size, TSRMLS_DC);
{$ELSE}
  php_body_write(Memory, Size, TSRMLS_DC);
{$ENDIF}

<p>

<br />

</p>
<p>

&nbsp; &nbsp;
至于完整的Fix版等手上工程忙完了再改个完整的放出来

</p>
<p>

&nbsp; &nbsp;
下图是我DeBug时的输出....

</p>
<p>

&nbsp; &nbsp;
数了下二十多个...

</p>
<p>

<br />

</p>
<p>

<br />

</p>
<p>

<a href="http://bcs.duapp.com/flandre/Blog/20140511/无标题.jpg"><img src="http://bcs.duapp.com/flandre/Blog/20140511/无标题.jpg" alt="无标题.jpg" /></a>

</p>