分类 笔记 下的文章

Delphi下的纯Pascal的十六进制转十进制

Function StrLenA(Str :PAnsiChar):Integer;
Begin
  Result := 0;
  while Str[Result] <> #$0 do Inc(Result)
End;  

Function Char2Int(A :AnsiChar):Integer;
Begin   //字符转整数
  Result := -1;
  if (Byte(A) > 47) And (Byte(A) < 58) Then
  Begin   //0-9
    Result := Byte(A) - 48;
  End Else if (Byte(A) > 64) And (Byte(A) < 71) then
  Begin   //A-F
    Result := Byte(A) - 55;
  End Else if (Byte(A) > 96) And (Byte(A) < 103) then
  Begin  //a-f
    Result := Byte(A) - 87;
  End;               
End;

Function HexPower(X, Y:Integer):UInt64;
Var     //次方计算
  I :Integer;
Begin
  Result := X;
  for I := 1 to Y do
  Begin
    Result := Result * 16;
  End;
End;  

Function Hex2Int(HEX :PAnsiChar):UInt64;
Var   //十六进制字符串转整数
  iLen :Integer;
  I    :Integer;
Begin
  iLen  := StrLenA(HEX);
  Result:= 0;
  for I:= 0 to iLen-2 do
  Begin
    Result := Result + HexPower(Char2Int(HEX[I]), iLen - (I + 1)); 
  End;  
  Result := Result + Char2Int(HEX[iLen-1]);
End;




代码实例:

Var
  HEX  :Array [0..16] Of AnsiChar;
begin
  HEX  := '14f03'#$0;  
  Writeln(Hex2Int(@HEX));

  HEX  := 'FFFFFFFF'#$0;  
  Writeln(Hex2Int(@HEX));
  
  HEX  := 'FFFFFFFFFFFFFFFF'#$0;  
  Writeln(Hex2Int(@HEX));
  Readln;  
End.



运行结果:


Untitled.jpg/

Delphi WinInet的HTTP操作2

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.WinInet, Vcl.StdCtrls, System.Math;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


Type
  THTTPHead = (nHead, nGet, nPost);

  PWebHead = ^TWebHead;
  TWebHead = Record
    uCode :Word;
    szSer :Array [0..64] Of AnsiChar;
  End;

  PDomain = ^TDomain;
  TDomain = Record
    szUrl  :Array [0..255] Of AnsiChar;
    szHost :Array [0..255] Of AnsiChar;
    szFile :Array [0..255] Of AnsiChar;
    bSSL   :Boolean;
    nPort  :Word;
  End;

Const
  HTTPHeadStr :Array [0..2] of PAnsiChar = ('HEAD', 'GET', 'POST');
  UserAgent:PAnsiChar = 'Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko';
  Header   :PAnsiChar = 'Content-Type: application/x-www-form-urlencoded'#13#10#$0;


Function StrStrIA(lpFirst, lpSrch: PAnsiChar): PAnsiChar; stdcall; external 'shlwapi.dll' name 'StrStrIA';
Function StrNCatA(lpFirst, lpSrch:PAnsiChar; cchMax:Integer): PAnsiChar; stdcall; external 'shlwapi.dll' name 'StrNCatA';
Function StrToIntA(lpSrch: PAnsiChar): Integer; stdcall; external 'shlwapi.dll' name 'StrToIntA';
Procedure RtlZeroMemory(Destination:Pointer; Length:DWORD); stdcall; external kernel32 name 'RtlZeroMemory';
Procedure RtlMoveMemory(Destination:Pointer; Const Source:Pointer; Length:DWORD); stdcall; external kernel32 name 'RtlMoveMemory';

Function AllocMemory(dwSize:DWORD):Pointer;
begin
  Result := VirtualAlloc(Nil, dwSize, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
end;

Function GetMemory(dwSize:DWORD):Pointer;
begin
  Result := AllocMemory(dwSize);
end;

Procedure FreeMemory(lpMemory :Pointer);
begin
  VirtualFree(lpMemory, 0, MEM_RELEASE);
end;

Function CheckMemory(pMemory:Pointer; dwSize:DWORD):Boolean;
begin
  Result := (Not IsBadReadPtr(pMemory, dwSize)) And (Not IsBadWritePtr(pMemory, dwSize));
end;

Function StrPosA(lpSrch, lpFirst:PAnsiChar):Integer;
Var
  Cmp :PAnsiChar;
begin
  Result := 0;
  if (lpSrch = Nil) Or (lpFirst = Nil) then Exit;
  if DWORD(lpSrch) = DWORD(lpFirst) then
  begin
    Result := 1;
    Exit;
  end;
  Cmp := StrStrIA(lpFirst, lpSrch);
  if Cmp <> Nil then
  begin
    Result := DWORD(Cmp) - DWORD(lpFirst) + 1;
  end;
end;

Procedure DeleteA(lpszStr:PAnsiChar; Index, Count:Integer);
Var
  uSize :Integer;
begin
  uSize  := lstrlenA(lpszStr);
  if uSize = Count then
  begin
    lstrcpyA(@lpszStr[index - 1], @lpszStr[Index + Count -1]);
    ZeroMemory(@lpszStr[index -1], Index + Count);
  end else begin
    lpszStr[Index - 1] := #0;
    StrNCatA(lpszStr, @lpszStr[Index + Count - 1], uSize);
  end;
end;

Function CopyA(lpszStr:PAnsiChar; Index, Count:Integer):PAnsiChar;
begin
  Result := GetMemory(Count - Index + 1);
  lstrcpynA(Result, @lpszStr[Index -1], Count);
end;

Procedure ParseURL(szUrl:PAnsiChar; Var Domain:TDomain);
Var
  nSize   :DWORD;
  szSeek  :PAnsiChar;
  szCmp   :PAnsiChar;
begin
  ZeroMemory(@Domain, SizeOf(TDomain));
  if StrStrIA(szUrl, 's://') <> Nil then Domain.bSSL := True;
  nSize  := StrPosA('://', szUrl);
  if nSize > 0 then
  begin
    szSeek := @szUrl[nSize + 2];
    lstrcpyA(@Domain.szUrl, szUrl);
  end else
  begin
    szSeek := szUrl;
    lstrcpyA(@Domain.szUrl, 'http://');
    lstrcatA(@Domain.szUrl, szUrl);
  end;
  nSize  := StrPosA(':', szSeek);
  if nSize > 0 then
  begin
    lstrcpynA(@Domain.szHost, szSeek, nSize);
    szSeek := @szSeek[nSize];
    nSize  := StrPosA('/', szSeek);
    if nSize > 0 then
    begin
      lstrcpynA(@Domain.szFile, szSeek, nSize);
      Domain.nPort := StrToIntA(Domain.szFile);
      ZeroMemory(@Domain.szFile, 256);
      szSeek := @szSeek[nSize - 1];
    end;
  end Else
  begin
    nSize  := StrPosA('/', szSeek);
    if nSize > 0 then lstrcpynA(@Domain.szHost, szSeek, nSize) Else lstrcpyA(@Domain.szHost, szSeek);
    szCmp  := StrStrIA(szUrl, 's://');
    if szCmp <> Nil then
    begin
      nSize := DWORD(szCmp) - DWORD(szUrl);
      if nSize  > 0 then Domain.nPort := 443;
    End Else Domain.nPort := 80;
  end;
  nSize  := StrPosA('/', szSeek);
  if nSize > 0 then lstrcpynA(@Domain.szFile, @szSeek[nSize], 255);
  if lstrlenA(@Domain.szFile)  = 0 then lstrcpyA(@Domain.szFile, '/');
end;

Function GetCode(szHead:PAnsiChar):Integer;
Var
  szSeek :PAnsiChar;
  uRet   :Integer;
begin
  Result := 0;
  szSeek := szHead;
  uRet   := StrPosA(' ', szSeek);
  if uRet > 0 then
  begin
    Inc(szSeek, uRet);
    uRet := StrPosA(' ', szSeek);
    if uRet > 0 then
    begin
      szSeek[uRet-1] := #$0;
      Result := StrToIntA(szSeek);
      szSeek[uRet-1] := ' ';
    end;
  end;
end;

Function GetWebSer(szHead:PAnsiChar):PAnsiChar;
Var
  szSeek :PAnsiChar;
  uRet   :Integer;
begin
  Result := Nil;
  szSeek := szHead;
  uRet   := StrPosA('Server:', szSeek);
  if uRet > 0 then
  begin
    Inc(szSeek, uRet + 7);
    uRet := StrPosA(#13, szSeek)-1;
    if uRet > 0 then
    begin
      szSeek[uRet] := #$0;
      Result := GetMemory(lstrlenA(szSeek) + 6);
      lstrcpyA(Result, szSeek);
      szSeek[uRet] := #13;
    end;
  end;
end;

Function GetPowered(szHead:PAnsiChar):PAnsiChar;
Var
  szSeek :PAnsiChar;
  uRet   :Integer;
begin
  Result := Nil;
  szSeek := szHead;
  uRet   := StrPosA('x-powered-by:', szSeek);
  if uRet > 0 then
  begin
    Inc(szSeek, uRet + 13);
    uRet := StrPosA(#13, szSeek)-1;
    if uRet > 0 then
    begin
      szSeek[uRet] := #$0;
      Result := GetMemory(lstrlenA(szSeek) + 6);
      lstrcpyA(Result, szSeek);
      szSeek[uRet] := #13;
    end;
  end;
end;

Function HexToInt(Const HexValue: String):Int64;
Var
  Code :Integer;
begin
  Val('$' + HexValue, Result, Code);
end;

Function HTTPExec(Head:THTTPHead; szURI:PAnsiChar; szCookies:PAnsiChar; pData:Pointer; dwLen:DWORD; Var StatuCode:DWORD):PAnsiChar;
const
  BufMax = 1024 *32;
Var
  Buffer    :Array [0..8191] of AnsiChar;
  hSession  :HINTERNET;
  hConnect  :HINTERNET;
  hRequest  :HINTERNET;
  Domain    :TDomain;
  pSeek     :PAnsiChar;
  dwMax     :DWORD;
  dwFlags   :DWORD;
  dwSize    :DWORD;
  dwRecv    :DWORD;
  dwStatus  :DWORD;
  dwHLen    :DWORD;
begin
  Result    := Nil;
  dwSize    := 0;
  dwRecv    := 0;
  ParseURL(szURI, Domain);
  if Domain.bSSL then dwFlags := INTERNET_FLAG_SECURE Else dwFlags := 0;
  if szCookies <> Nil then InternetSetCookieA(szURI, Nil, szCookies);
  hSession   := InternetOpenA(UserAgent, INTERNET_OPEN_TYPE_PRECONFIG, Nil, Nil, 0);
  if hSession <> Nil then
  begin
    hConnect := InternetConnectA(hSession, Domain.szHost, Domain.nPort, Nil, Nil, INTERNET_SERVICE_HTTP, 0, 0);
    if hConnect <> Nil then
    begin
      hRequest := HttpOpenRequestA(hConnect, HTTPHeadStr[Integer(Head)], Domain.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
      if hRequest <> Nil then
      begin
        if Head = nPost then HttpAddRequestHeadersA(hRequest, Header, lstrlenA(Header), dwFlags Or HTTP_ADDREQ_FLAG_ADD Or HTTP_ADDREQ_FLAG_REPLACE);
        if HttpSendRequestA(hRequest, Nil, 0, pData, dwLen) then
        begin
          StatuCode := 0;
          HttpQueryInfoA(hRequest, HTTP_QUERY_STATUS_CODE Or HTTP_QUERY_FLAG_NUMBER, @StatuCode, dwStatus, dwRecv);
          if Head = nHead then
          begin
            HttpQueryInfoA(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, Nil, dwSize, dwRecv);
            if dwSize > 0 then
            begin
              Result := GetMemory(dwSize);
              HttpQueryInfoA(hRequest, HTTP_QUERY_RAW_HEADERS_CRLF, Result, dwSize, dwRecv);
            end;
          end else
          begin
            dwSize := 0;
            HttpQueryInfoA(hRequest, HTTP_QUERY_CONTENT_LENGTH Or HTTP_QUERY_FLAG_NUMBER, @dwSize, dwStatus, dwRecv);
            if dwSize > 0 then
            begin
              Result := GetMemory(dwSize);
              pSeek  := Result;
              Repeat
                if InternetReadFile(hRequest, pSeek, dwSize, dwRecv) then
                begin
                  Dec(dwSize, dwRecv);
                  Inc(PByte(pSeek), dwRecv);
                end;  
              Until dwSize = 0;
            end else
            begin
              dwMax := 1024 * 32;
              dwHLen := 0;
              Result := GetMemory(dwMax);
              pSeek  := Result;
              RtlZeroMemory(Result, dwMax);
              Repeat
                RtlZeroMemory(@Buffer, SizeOf(Buffer));
                if InternetReadFile(hRequest, @Buffer, SizeOf(Buffer), dwRecv) And (dwRecv > 0) then
                begin
                  if (dwMax - dwHLen) < 1024 then
                  begin
                    pSeek  := Result;
                    Result := GetMemory(dwMax + BufMax);
                    if dwHLen > 0 then RtlMoveMemory(Result, pSeek, dwHLen);
                    FreeMemory(pSeek);
                    pSeek  := Result;
                    Inc(PByte(pSeek), dwHLen);
                    Inc(dwMax, BufMax);
                  end;
                  if dwRecv > 0 then
                  begin
                    RtlMoveMemory(pSeek, @Buffer, dwRecv);
                    Inc(PByte(pSeek), dwRecv);
                    Inc(dwHLen, dwRecv);                    
                  end;  
                end;  
                Sleep(30);
              Until dwRecv = 0;
            end;    
          end;   
        end;
        InternetCloseHandle(hRequest);
      end;
      InternetCloseHandle(hConnect);
    end;
    InternetCloseHandle(hSession);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Buffer :PAnsiChar;
  Status :DWORD;
begin
  Buffer     := HTTPExec(nHead, 'http://www.baidu.com/', Nil, Nil, 0, Status);
  Memo1.Text := String(AnsiString(Buffer));
  FreeMemory(Buffer);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
  Buffer :PAnsiChar;
  Status :DWORD;
begin
  Buffer     := HTTPExec(nGet, 'http://www.baidu.com/', Nil, Nil, 0, Status);
  Memo1.Text := String(AnsiString(Buffer));
  FreeMemory(Buffer);
end;


procedure TForm1.Button3Click(Sender: TObject);
var
  Buffer :PAnsiChar;
  Status :DWORD;
  pSend  :PAnsiChar;
begin
  pSend      := GetMemory(MAX_PATH);
  lstrcpyA(pSend, 's=delphi');
  Buffer     := HTTPExec(nPost, 'http://7xcode.com/', Nil, pSend, lstrlenA(pSend), Status);
  Memo1.Text := String(AnsiString(Buffer));
  FreeMemory(Buffer);
  FreeMemory(pSend);
end;
end.


Process32First/Process32Next X64下使用

  PProcessEntryW = ^TProcessEntryW;
  TProcessEntryW = Record
    dwSize:DWORD;
    {$IFDEF CPUX64}
    cntUsage:UInt64;
    {$ELSE}
    cntUsage:DWORD;
    {$ENDIF}
    th32ProcessID:DWORD;
    th32DefaultHeapID:DWORD;
    th32ModuleID:DWORD;
    cntThreads:DWORD;
    th32ParentProcessID:DWORD;
    pcPriClassBase:DWORD;
    dwFlags:DWORD;
    szExeFile:Array[0..MAX_PATH - 1] of WideChar;
  end;

将数据类型tagPROCESSENTRY32中的cntUsage修改下即可 X86下用32位的无符号整数X64下用64位的无符号整数

之前搜了好多有人在MSDN社区说把dwFlags修改成64位整数结果测试后完全无效....

只修改个cntUsage即可 Win7 SP1 X64测试完全可用

Patch1:

不过有个很蛋疼的问题是 这套API本应该是给32位用的 64位用本来就不合适

强制改数据类型用是可以用但是 数据会错位...

cntUsage修改成8位直接的64位整数后直接取th32ProcessID的话肯定会返回0

解决方法就是向前挪2位....

Patch2:

PID

th32ProcessID        = PDWORD(PByte(DWORD(@tagPROCESSENTRY32) + 8))^;

父进程PID

th32ParentProcessID  = PDWORD(PByte(DWORD(@tagPROCESSENTRY32) + 32))^;

进程名称

szExeFile            = PWideChar(PByte(DWORD(@tagPROCESSENTRY32) + 44));

其余的不用基本没啥用

Delphi使用WM_CopyData来进行多进程之间的数据传递

下面代码只为实现不考虑线程安全因素 仅供参考

unit Unit_Main;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
  TForm_Main = class(TForm)
    Memo: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure ShareMSG(Var Msg:TMessage); Message WM_COPYDATA;
  end;
Var
  Form_Main: TForm_Main;
  uMax     :Integer;
implementation
{$R *.dfm}
Procedure TForm_Main.ShareMSG(Var Msg:TMessage);
begin
  if Msg.Msg = WM_COPYDATA then
  begin
    Caption    := '第:' + IntToStr(PCopyDataStruct(Msg.LParam)^.cbData) + '次收到数据!~';
    Msg.Result := 1; //返回1
  end;
end;

Function ThreadProc(lpParam:Pointer):DWORD; Stdcall;
Var
  hWin  :HWND;
  Data  :TCopyDataStruct;
  uCount:Integer;
begin
  Result := 0;
  hWin   := HWND(lpParam);
  for uCount := 1 to uMax do
  begin
    ZeroMemory(@Data, SizeOf(Data));
    Data.dwData := 0;
    Data.cbData := uCount;  //数据的大小
    Data.lpData := Nil;     //数据内存指针
    if SendMessage(hWin, WM_COPYDATA, 0, lParam(@Data)) = 1 then
    begin
      Form_Main.Memo.Lines.Add('第:' + IntToStr(uCount) + '次发送!~');
    end;
    Sleep(30);
  end;    
end;  

procedure TForm_Main.Button1Click(Sender: TObject);
Var
  hWin :HWND;
  lThread   :THandle;
  lThreadId :DWORD;  
begin
  hWin := FindWindowW('TForm_Main', 'Process_B'); 
  if hWin > 32 then
  begin
    uMax    := StrToInt(Edit1.Text);
    lThread := CreateThread(nil, 0, @ThreadProc, Pointer(hWin), 0, lThreadId);
    CloseHandle(lThread);
  end Else
  begin
    Memo.Lines.Text := '没有找到进程B的窗口';
  end;    
end;
end.


Delphi DLL注入x86/x64/Win2k~Win8.1全可用

之前测东西的时候要用就随手倒腾了一个

program Inject;

{$APPTYPE CONSOLE}


{$IF CompilerVersion >= 21.0}
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
{$IFEND}

uses
  Winapi.Windows;
  
Type
  NtCreateThreadExProc = Function(Var hThread:THandle; Access:DWORD; Attributes:Pointer; hProcess:THandle; pStart:Pointer; pParameter:Pointer; Suspended:BOOL; StackSize, u1, u2:DWORD; Unknown:Pointer):DWORD; stdcall;  


Function CheckOs():Boolean;
Var
  lpVersionInformation :TOSVersionInfoW;
begin
  Result := False;
  if GetVersionExW(lpVersionInformation) then
  begin
    if lpVersionInformation.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    begin
      if (lpVersionInformation.dwMajorVersion < 6) then
      begin
        Result := True;
      end;  
    end;  
  end;
end;

Function EnableDebugPrivilege():Boolean;
Var
  hToKen   :THandle;
  TokenPri :TTokenPrivileges;
begin
  Result := False;
  if(OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES, hToKen)) Then
  begin
    TokenPri.PrivilegeCount  := 1;
    If LookupPrivilegeValueW(Nil, 'SeDebugPrivilege', TokenPri.Privileges[0].Luid) Then
    begin
      TokenPri.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      Result := AdjustTokenPrivileges(hToken, False, TokenPri, SizeOf(TTokenPrivileges),  Nil, PDWORD(Nil)^);
    end Else Writeln('LookupPrivilege Error');
    CloseHandle(hToKen);
  end;
end;

Function RemoteThread(hProcess:THandle; pThreadProc:Pointer; pRemote:Pointer):THandle;
Label NtCreate, Create;
Var
  pFunc    :Pointer;
  hThread  :THandle;
begin
  hThread := 0;
  if Not CheckOs() then //根据系统版本来选择使用的API
  begin
    NtCreate:
    pFunc   := GetProcAddress(LoadLibraryW('ntdll.dll'), 'NtCreateThreadEx'); 
    if pFunc = Nil then Goto Create;  
    NtCreateThreadExProc(pFunc)(hThread, $1FFFFF, Nil, hProcess, pThreadProc, pRemote, False, 0, 0, 0, Nil);
    if hThread = 0 then Goto Create;
  end Else
  begin
    Create:
    hThread := CreateRemoteThread(hProcess, Nil, 0, pThreadProc, pRemote, 0, PDWORD(Nil)^);    		
  end; 
  Writeln('RemoteThread Ok!');
  Result := hThread;
end;  

Function InjectDll2Pid(szPath:PWideChar; uPID:DWORD):Boolean;
Var
  hProcess  :THandle;
  hThread   :THandle;
  szRemote  :PWideChar;
  uSize     :SIZE_T;
  uWrite    :SIZE_T;
  pStartAddr:Pointer;
begin
  Result := False;
  if EnableDebugPrivilege then
  begin //先提升下进程的权限
    hProcess := OpenProcess(PROCESS_ALL_ACCESS, false, uPID);
    if hProcess > 0 then
    begin
      uSize    := lstrlenW(szPath) * 2 + 4;
      szRemote := VirtualAllocEx(hProcess, Nil, uSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
      if WriteProcessMemory(hProcess, szRemote, szPath, uSize, uWrite) And (uWrite = uSize) then
      begin
        pStartAddr := GetProcAddress(LoadLibrary('Kernel32.dll'), 'LoadLibraryW');
        hThread := RemoteThread(hProcess, pStartAddr, szRemote);
        Result  := hThread <> 0;
        CloseHandle(hThread);
      end Else
      begin
        Writeln('WriteMemory Error');
      end;  
    end;  
  end;  
end;  

Function StrToInt(S: String): Integer;
Var
  E: Integer;
Begin
  Val(S, Result, E);
End;

begin
  InjectDll2Pid(PWideChar(ParamStr(2)), StrToInt(ParamStr(1)));
end.