标签 delphi 下的文章

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.


Delphi 检测文件数字签名

Uses Winapi.Windows, JwaSoftpub, CAPICOM_TLB, JwaWintrust;

Function IsCodeSigned(const Filename:String):Boolean;
var
  FileInfo   :TWinTrustFileInfo;
  TrustData  :TWinTrustData;
begin
  ZeroMemory(@FileInfo, SizeOf(TWintrustFileInfo));
  ZeroMemory(@TrustData, SizeOf(TWinTrustData));
  FileInfo.cbStruct             := SizeOf(TWintrustFileInfo);
  FileInfo.pcwszFilePath        := PWideChar(FileName);
  TrustData.cbStruct            := sizeof(TrustData);
  TrustData.dwUIChoice          := WTD_UI_NONE;
  TrustData.fdwRevocationChecks := WTD_REVOKE_NONE;
  TrustData.dwUnionChoice       := WTD_CHOICE_FILE;
  TrustData.InfoUnion.pFile     := @FileInfo;
  Result := WinVerifyTrust(INVALID_HANDLE_VALUE, WINTRUST_ACTION_GENERIC_VERIFY_V2, TrustData) = ERROR_SUCCESS;
end;

Delphi 获取Windows本地用户组和用户列表

头文件不全请加载    JEDI Windows Security Code Library 


{$POINTERMATH ON}
Function GetUserGroup():Integer;
Var
  szComputer:Array [0..MAXCHAR] Of WideChar;
  Buffer    :LPLOCALGROUP_INFO_1;
  nTotal    :DWORD;
  nEntries  :DWORD;
  hResume   :PDWORD_PTR;
  nCount    :DWORD;
  nStatus   :DWORD;
  dwPrefMax :DWORD;
  lpszStr   :Array [0..MAX_PATH] Of WideChar;
  iLen      :Integer;
  iFull     :Integer;
begin
  Result   := 0;
  nEntries := SizeOf(szComputer);
  GetComputerNameW(@szComputer, nEntries);
  nEntries   := 0;
  nTotal     := 0;
  Buffer     := Nil;
  dwPrefMax  := MAX_PREFERRED_LENGTH;
  hResume    := Nil;

  Writeln('User Group:', szComputer);
  nStatus    := NetLocalGroupEnum(szComputer, 0, PByte(Buffer), dwPrefMax, @nEntries, @nTotal, @hResume);
  if (nStatus = S_OK) Or (nStatus = ERROR_MORE_DATA) then
  begin
    for nCount := 0 to nTotal-1 do
    begin
      Inc(Result);
      if Buffer[nCount].lgrpi1_comment = Nil then Break;

      iLen := lstrlenW(Buffer[nCount].lgrpi1_comment);
      iFull:= 40 - Min(iLen, 32);
      ZeroMemory(@lpszStr, SizeOf(lpszStr));
      FillSpaces(@lpszStr, 10, True);

      lstrcatW(lpszStr, Buffer[nCount].lgrpi1_comment);
      FillSpaces(@lpszStr[iLen + 10], iFull, True);

      lstrcatW(lpszStr, Buffer[nCount].lgrpi1_name);

      Writeln(lpszStr);
    end;
  end;

  if Buffer <> Nil then
    NetApiBufferFree(Buffer);

  Writeln('.Done!, Total: ', Result);
end;


Function GetUsers():Integer;
Var
  szComputer:Array [0..MAXCHAR] Of WideChar;
  Buffer    :PUserInfo3;
  nTotal    :DWORD;
  nEntries  :DWORD;
  hResume   :PDWORD_PTR;
  nCount    :DWORD;
  dwPrefMax :DWORD;
  nStatus   :DWORD;
  lpszStr   :Array [0..MAX_PATH] Of WideChar;
begin
  Result   := 0;
  nEntries := SizeOf(szComputer);
  GetComputerNameW(@szComputer, nEntries);
  nEntries   := 0;
  nTotal     := 0;

  nEntries   := 0;
  nTotal     := 0;
  Buffer     := Nil;
  dwPrefMax  := MAX_PREFERRED_LENGTH;
  hResume    := Nil;

  Writeln('User Group:', szComputer);
  nStatus    := NetUserEnum(szComputer, 3, FILTER_NORMAL_ACCOUNT, PByte(Buffer), dwPrefMax, @nEntries, @nTotal, @hResume);
  if (nStatus = S_OK) Or (nStatus = ERROR_MORE_DATA) then
  begin
    for nCount := 0 to nTotal-1 do
    begin
      Inc(Result);
      if Buffer[nCount].usri3_name = Nil then
      begin
        if nCount < nTotal then
        begin
          Continue;
        end Else Break;
      end;

      ZeroMemory(@lpszStr, SizeOf(lpszStr));
      FillSpaces(@lpszStr, 10, True);
      lstrcatW(lpszStr, Buffer[nCount].usri3_name);
      Writeln(lpszStr, #13);

      ZeroMemory(@lpszStr, SizeOf(lpszStr));
      FillSpaces(@lpszStr, 15, True);
      lstrcatW(lpszStr, 'Remarks:');
      lstrcatW(lpszStr, Buffer[nCount].usri3_comment);
      Writeln(lpszStr);

      ZeroMemory(@lpszStr, SizeOf(lpszStr));
      FillSpaces(@lpszStr, 15, True);
      lstrcatW(lpszStr, 'Privilege:');
      if Buffer[nCount].usri3_priv = 0 then
      begin
        lstrcatW(lpszStr, 'Guest');
      end Else
      if Buffer[nCount].usri3_priv = 1 then
      begin
        lstrcatW(lpszStr, 'User');
      end Else
      if Buffer[nCount].usri3_priv = 2 then
      begin
        lstrcatW(lpszStr, 'Admin');
      end Else
      begin
        lstrcatW(lpszStr, 'UnKnown');
      end;
      Writeln(lpszStr);

      if (Buffer[nCount].usri3_script_path <> Nil) And (lstrlenW(Buffer[nCount].usri3_script_path) > 0) then
      begin
        ZeroMemory(@lpszStr, SizeOf(lpszStr));
        FillSpaces(@lpszStr, 15, True);
        lstrcatW(lpszStr, 'Login Script:');
        lstrcatW(lpszStr, Buffer[nCount].usri3_script_path);
        Writeln(lpszStr);
      end;
      Writeln('');
    end;
  end;
  if Buffer <> Nil then
    NetApiBufferFree(Buffer);

  Writeln('.Done!, Total: ', Result);
end;


Delphi 获取Windows系统会话用户名

Function GetLogUser(Var dwCount :DWORD):PLPChar;
Var
  szLogName     :PAnsiChar;
  dwSize        :DWORD;
  I             :DWORD;
  SessionsInfo  :PWTS_SESSION_INFOA;
  SessionsSeek  :PWTS_SESSION_INFOA;
  SessionsCount :DWORD;

  szBuffer      :Array [0..MAXCHAR * 64] of AnsiChar;
  lpszSeek      :PAnsiChar;
begin
  Result    := Nil;
  dwCount   := 0;
  if WTSEnumerateSessionsA(WTS_CURRENT_SERVER_HANDLE, 0, 1, SessionsInfo, SessionsCount) then
  begin
    ZeroMemory(@szBuffer, SizeOf(szBuffer));
    lpszSeek := PAnsiChar(@szBuffer);
    SessionsSeek := SessionsInfo;
    For I:= 0 To SessionsCount - 1 do
    begin
      if (SessionsSeek.State = WTSActive) or (SessionsSeek.State = WTSDisconnected) then
      begin
        szLogName := Nil;
        dwSize    := 0;
        if WTSQuerySessionInformationA(WTS_CURRENT_SERVER_HANDLE, SessionsSeek.SessionId, WTSUserName, szLogName, dwSize) And (szLogName[0] <> #0) then
        begin
          Inc(dwCount);
          lstrcpyA(lpszSeek, szLogName);
          Inc(lpszSeek, lstrlenA(lpszSeek) + 1);
          WTSFreeMemory(szLogName);
        end;
      end;
      Inc(SessionsSeek);
    end;
    WTSFreeMemory(SessionsInfo);
  end;
  if (dwCount > 0) And (szBuffer[0] <> #0) then
  begin
    Result := GetMemory(SizeOf(PAnsiChar) * (dwCount + 2));
    if (Result <> Nil) And CheckMemory(Result, SizeOf(PAnsiChar) * (dwCount + 2)) then
    begin
      lpszSeek := PAnsiChar(@szBuffer);
      for I := 0 to dwCount-1 do
      begin
        dwSize  := lstrlenA(lpszSeek);
        Result[I] := GetMemory(dwSize + 1);
        if (Result[I] <> Nil) And CheckMemory(Result[I], dwSize + 1) then
        begin
          lstrcpynA(Result[I], lpszSeek, dwSize + 1)
        end;
        Inc(lpszSeek, dwSize + 1);
      end;
    end;
  end;
end;