Показать сообщение отдельно

  #4  
Старый 19.02.2009, 23:36
PandoraBox
Постоянный
Регистрация: 06.05.2007
Сообщений: 393
Провел на форуме:
1510937

Репутация: 398
Отправить сообщение для PandoraBox с помощью ICQ
По умолчанию

Код:
unit Bugagu;

interface

uses Windows, WinInet;

  function UrlEncode(Str: string): string;
  function UrlDecode(Str: string): string;
  function GetFileData(szFile: PChar): PChar;
  procedure Send_POST_Data(Const szHost, szPath, szData: PChar);

implementation

function UrlEncode(Str: string): string;
  function CharToHex(Ch: Char): Integer;
  asm
    and eax, 0FFh
    mov ah, al
    shr al, 4
    and ah, 00fh
    cmp al, 00ah
    jl @@10
    sub al, 00ah
    add al, 041h
    jmp @@20
@@10:
    add al, 030h
@@20:
    cmp ah, 00ah
    jl @@30
    sub ah, 00ah
    add ah, 041h
    jmp @@40
@@30:
    add ah, 030h
@@40:
    shl eax, 8
    mov al, '%'
  end;
var
  i, Len: Integer;
  Ch: Char;
  N: Integer;
  P: PChar;
begin
  Result := '';
  Len := Length(Str);
  P := PChar(@N);
  for i := 1 to Len do
  begin
    Ch := Str[i];
    if Ch in ['0'..'9', 'A'..'Z', 'a'..'z', '_'] then
      Result := Result + Ch
    else
    begin
      if Ch = ' ' then
        Result := Result + '+'
      else
      begin
        N := CharToHex(Ch);
        Result := Result + P;
      end;
    end;
  end;
end;

function UrlDecode(Str: string): string;
  function HexToChar(W: word): Char;
  asm
   cmp ah, 030h
   jl @@error
   cmp ah, 039h
   jg @@10
   sub ah, 30h
   jmp @@30
@@10:
   cmp ah, 041h
   jl @@error
   cmp ah, 046h
   jg @@20
   sub ah, 041h
   add ah, 00Ah
   jmp @@30
@@20:
   cmp ah, 061h
   jl @@error
   cmp al, 066h
   jg @@error
   sub ah, 061h
   add ah, 00Ah
@@30:
   cmp al, 030h
   jl @@error
   cmp al, 039h
   jg @@40
   sub al, 030h
   jmp @@60
@@40:
   cmp al, 041h
   jl @@error
   cmp al, 046h
   jg @@50
   sub al, 041h
   add al, 00Ah
   jmp @@60
@@50:
   cmp al, 061h
   jl @@error
   cmp al, 066h
   jg @@error
   sub al, 061h
   add al, 00Ah
@@60:
   shl al, 4
   or al, ah
   ret
@@error:
   xor al, al
  end;

  function GetCh(P: PChar; var Ch: Char): Char;
  begin
    Ch := P^;
    Result := Ch;
  end;
var
  P: PChar;
  Ch: Char;
begin
  Result := '';
  P := @Str[1];
  while GetCh(P, Ch) <> #0 do
  begin
    case Ch of
      '+': Result := Result + ' ';
      '%':
        begin
          Inc(P);
          Result := Result + HexToChar(PWord(P)^);
          Inc(P);
        end;
    else
      Result := Result + Ch;
    end;
    Inc(P);
  end;
end;

function GetFileData(szFile: PChar): PChar;
var
 hFile, dwSize, dwBytes: DWORD;
begin
 Result := '';
 hFile := CreateFile(szFile, GENERIC_READ, 0, nil, OPEN_EXISTING, 0, 0);
 if hFile <> INVALID_HANDLE_VALUE then
 begin
  dwSize := GetFileSize(hFile, nil);
  Result := VirtualAlloc(nil, dwSize, MEM_COMMIT, PAGE_READWRITE);
  ReadFile(hFile, Result^, dwSize, dwBytes, nil);
 end;
 CloseHandle(hFile);
end;

procedure Send_POST_Data(Const szHost, szPath, szData: PChar);
var
  hOpenHandle, hConnectHandle, hResourceHandle: Pointer;
begin
 hOpenHandle := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
 if hOpenHandle <> nil then
 begin
  hConnectHandle := InternetConnect(hOpenHandle, szHost, 80, nil, nil, 3, 0, 0);
  if hConnectHandle<>nil then
  begin
   hResourceHandle := HttpOpenRequest(hConnectHandle, 'POST', szPath, nil, nil, nil, INTERNET_FLAG_KEEP_CONNECTION, 0);
   if hResourceHandle <> nil then
    begin
     HttpSendRequest(hResourceHandle, 'Content-Type: application/x-www-form-urlencoded', 47, szData, lstrlen(szData));
    end;
    InternetCloseHandle(hResourceHandle);
   end;
   InternetCloseHandle(hConnectHandle);
  end;
  InternetCloseHandle(hOpenHandle);
end;
 
Ответить с цитированием