分类 分享 下的文章

Delphi一个基于WinInet的HTTP操作小函数

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
  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';

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;

Function ParseURL(szUrl:PAnsiChar):PDomain;
Var
  nSize   :DWORD;
  szSeek  :PAnsiChar;
  szCmp   :PAnsiChar;
begin
  Result := GetMemory(SizeOf(TDomain));
  ZeroMemory(Result, SizeOf(TDomain));
  if StrStrIA(szUrl, 's://') <> Nil then Result^.bSSL := True;
  nSize  := StrPosA('://', szUrl);
  if nSize > 0 then
  begin
    szSeek := @szUrl[nSize + 2];
    lstrcpyA(@Result^.szUrl, szUrl);
  end else
  begin
    szSeek := szUrl;
    lstrcpyA(@Result^.szUrl, 'http://');
    lstrcatA(@Result^.szUrl, szUrl);
  end;
  nSize  := StrPosA(':', szSeek);
  if nSize > 0 then
  begin
    lstrcpynA(@Result^.szHost, szSeek, nSize);
    szSeek := @szSeek[nSize];
    nSize  := StrPosA('/', szSeek);
    if nSize > 0 then
    begin
      lstrcpynA(@Result^.szFile, szSeek, nSize);
      Result^.nPort := StrToIntA(Result^.szFile);
      ZeroMemory(@Result^.szFile, 256);
      szSeek := @szSeek[nSize - 1];
    end;
  end Else
  begin
    nSize  := StrPosA('/', szSeek);
    if nSize > 0 then lstrcpynA(@Result^.szHost, szSeek, nSize) Else lstrcpyA(@Result^.szHost, szSeek);
    szCmp  := StrStrIA(szUrl, 's://');
    if szCmp <> Nil then
    begin
      nSize := DWORD(szCmp) - DWORD(szUrl);
      if nSize  > 0 then Result^.nPort := 443;
    End Else Result^.nPort := 80;
  end;
  nSize  := StrPosA('/', szSeek);
  if nSize > 0 then lstrcpynA(@Result^.szFile, @szSeek[nSize], 255);
  if lstrlenA(@Result^.szFile)  = 0 then lstrcpyA(@Result^.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 HTTP_Exec(lpHead:THTTPHead; szUrl:PAnsiChar; Data:Pointer; dSize:DWORD; Cookies:PAnsiChar; Var uCode:DWORD):PByte;
Const
  IntBufSize  = 8192;
Var
  Session   :HINTERNET;
  Connect   :HINTERNET;
  Resource  :HINTERNET;
  dwFlags   :DWORD;
  Buffer    :Array[0..IntBufSize-1] of AnsiChar;
  uSize     :DWORD;
  uRecv     :DWORD;
  dwDomain  :PDomain;
  Stream    :TMemoryStream;
begin
  Result    := Nil;
  uCode     := 0;
  Stream    := TMemoryStream.Create;
  dwDomain  := ParseURL(szUrl);
  if dwDomain = Nil then Exit;
  if dwDomain^.bSSL then dwFlags := INTERNET_FLAG_SECURE Else dwFlags := 0;
  if Cookies <> Nil then InternetSetCookieA(szUrl, Nil, Cookies);
  Session   := InternetOpenA(UserAgent, INTERNET_OPEN_TYPE_PRECONFIG, Nil, Nil, 0);
  if Session <> Nil then
  begin
    Connect := InternetConnectA(Session, @dwDomain^.szHost, dwDomain^.nPort, Nil, Nil, INTERNET_SERVICE_HTTP, 0, 0);
    if Connect <> Nil then
    begin
      case lpHead of
        nHead :
        begin
          Resource := HttpOpenRequestA(Connect, 'HEAD', @dwDomain^.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
          if Resource <> Nil then
          begin
            if HttpSendRequestA(Resource, Nil, 0, Nil, 0) then
            begin
              uSize := SizeOf(Buffer);
              ZeroMemory(@Buffer, uSize);
              uRecv := 0;
              if HttpQueryInfoA(Resource, HTTP_QUERY_RAW_HEADERS_CRLF, @Buffer, uSize, uRecv) then
              begin
                Stream.WriteBuffer(Buffer, lstrlenA(@Buffer));
                uCode := GetCode(@Buffer);
              end;
            end;
          end;
        end;
        nGet  :
        begin
          Resource := HttpOpenRequestA(Connect, 'GET', @dwDomain^.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
          if Resource <> Nil then
          begin
            if HttpSendRequestA(Resource, Nil, 0, Nil, 0) then
            begin
              uSize := SizeOf(DWORD);
              uRecv := 0;
              if HttpQueryInfoA(Resource, HTTP_QUERY_STATUS_CODE Or HTTP_QUERY_FLAG_NUMBER, @uCode, uSize, uRecv) then
              begin
                repeat
                  if InternetReadFile(Resource, @Buffer, IntBufSize, uRecv) then
                  begin
                    Stream.WriteBuffer(Buffer, uRecv);
                  end;
                until uRecv = 0;
              end;
            end;
          end;
        end;
        nPost :
        begin
          Resource := HttpOpenRequestA(Connect, 'POST', @dwDomain^.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
          if Resource <> Nil then
          begin
            If HttpAddRequestHeadersA(Resource, Header, lstrlenA(Header), dwFlags Or HTTP_ADDREQ_FLAG_ADD Or HTTP_ADDREQ_FLAG_REPLACE) Then
            begin
              if HttpSendRequestA(Resource, Nil, 0, Data, dSize) then
              begin
                uSize := SizeOf(DWORD);
                uRecv := 0;
                if HttpQueryInfoA(Resource, HTTP_QUERY_STATUS_CODE Or HTTP_QUERY_FLAG_NUMBER, @uCode, uSize, uRecv) then
                begin
                  repeat
                    if InternetReadFile(Resource, @Buffer, IntBufSize, uRecv) then
                    begin
                      Stream.WriteBuffer(Buffer, uRecv);
                    end;
                  until uRecv = 0;
                end;
              end;
            end;
          end;
        end;
      end;
      InternetCloseHandle(Connect);
    end;
    InternetCloseHandle(Session);
  end;
  if Stream.Size > 0 then
  begin
    Result := GetMemory(Stream.Size);
    CopyMemory(Result, Stream.Memory, Stream.Size);
  end;
  Stream.Free;
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.


Ping包的DNS查询代码For Delphi

抓包抓的是Ping包的查询不是Nslookup所以内容有点少

Type
  PDNS_HDR = ^DNS_HDR;
  DNS_HDR = Record
    id    :Word; //ID编号有本地指定 服务器 返回时也带有此ID
    tag   :Word;
    numq  :Word;
    numa  :Word;
    numa1 :Word;
    numa2 :Word;
  End;

  PDNS_QER = ^DNS_QER;
  DNS_QER = Record
    utype   :Word;
    classes :Word;
  End;

  TIPAddr = Array [0..3] Of Byte;

Const
  BUF_SIZE = 1024;
  SRV_PORT = 53;
  
  
Function QueryDNS(szHost:PAnsiChar; Server:PAnsiChar):TIPAddr;
Label OnExit;
Var
  dnshdr :PDNS_HDR;
  dnsqer :PDNS_QER;
  Buffer :Array [0..BUF_SIZE-1] Of Byte;
  nSocket:TSocket;
  SerAddr:TSockAddrIn;
  I      :Integer;
  nRet   :Integer;
  dwLen  :Integer;
begin
  ZeroMemory(@Result, SizeOf(TIPAddr));
  nSocket := socket(AF_INET, SOCK_DGRAM, 0);
  If nSocket = INVALID_SOCKET then  Exit;
  SetSocketIoOutTime(nSocket, 8000);
  SerAddr.sin_family        := AF_INET;
  SerAddr.sin_port          := Htons(SRV_PORT);
  SerAddr.sin_addr.s_addr   := Inet_Addr(Server);
  if SerAddr.sin_addr.s_addr = SOCKET_ERROR then Goto OnExit;
  ZeroMemory(@Buffer, BUF_SIZE);
  Randomize;
  dnshdr       := @Buffer;
  dnshdr^.id   := Random(65534);  //随机个ID
  dnshdr^.tag  := htons($0100);
  dnshdr^.numq := htons(1);
  dnshdr^.numa := 0;
  lstrcpyA(@Buffer[SizeOf(DNS_HDR) + 1], szHost);
  I           := SizeOf(DNS_HDR) + 1;
  dwLen       := 0;
  While dwLen < lstrlenA(szHost)-2 Do
  begin
    if Buffer[I + dwLen] = 0 then Break;
    If AnsiChar(Buffer[I + dwLen]) = '.' Then
    begin
      Buffer[I - 1] := dwLen;
      Inc(I, dwLen + 1);
      dwLen := 0;
    end Else
    begin
      Inc(dwLen);
    end;
  end;
  Buffer[I - 1]   := dwLen;
  dnsqer          := PDNS_QER(@Buffer[SizeOf(DNS_HDR) + 3 + lstrlenA(szHost) - 1]);
  dnsqer^.utype   := htons(1);
  dnsqer^.classes := htons(1);
  sendto(nSocket, Buffer, SizeOf(DNS_HDR) + SizeOf(DNS_QER) + lstrlenA(szHost) + 2, 0, SerAddr, SizeOf(TSockAddrIn));
  I    := SizeOf(TSockAddrIn);
  ZeroMemory(@Buffer, BUF_SIZE);
  nRet := recvfrom(nSocket, Buffer, BUF_SIZE, 0, SerAddr, I);
  if dnshdr.numa = 0 then //这里=0是不存在的域名
  begin
    Result[0] := 0;
    Result[1] := 0;
    Result[2] := 0;
    Result[3] := 0;
    Goto OnExit;
  End Else
  begin
    dwLen     := nRet - 4;
    Result[0] := Buffer[dwLen];
    Result[1] := Buffer[dwLen+1];
    Result[2] := Buffer[dwLen+2];
    Result[3] := Buffer[dwLen+3];
  end;

  OnExit :
  closesocket(nSocket);
end;


Games for Windows LIVE游戏运行没反应或者xlive安装错误代码0x800b0003的解决

先卸载原有的games live

然后下载在线安装



http://download.gfwl.xboxlive.com/content/gfwl-public/redists/production/gfwlivesetup.exe



如果安装出错提示 0x800b0003

点击 logs按钮查看日志



然后找Download folder 后面的路径

然后进到这个文件夹里 进之前不要关闭live的安装器

进去后有3个MSI文件 复制出来

然后关掉live安装器

着三个文件依次安装就行了