unthttp.pas

实现了：自动锁屏

unit untHttp;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls,winsock, StrUtils,
  ComCtrls, ExtCtrls, untGlobal;

const

  HTTP = 'POST /edu/hospital.ejf HTTP/1.1' + #13#10
  + 'Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*' + #13#10
//  + 'Referer: http://192.167.0.211:8080/edu/login.htm' + #13#10
  + 'Accept-Language: zh-cn' + #13#10
  + 'Content-Type: application/x-www-form-urlencoded' + #13#10
  + 'Accept-Encoding: gzip, deflate' + #13#10
  + 'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; TencentTraveler ; .NET CLR 2.0.50727)' + #13#10
  + 'Host: %s:%d' + #13#10
  + 'Content-Length: %d' + #13#10
  + 'Connection: Keep-Alive' + #13#10
  + 'Cache-Control: no-cache' + #13#10
  + #13#10
  + '%S';

  REQUEST = 'action=%s&uid=%s&pwd=%s%s' + #13#10;

  const GetMethod = 12548;
  const PostMethod = 15467;
  const PostMethod_2 = 12345;

  function getHttpDataByPostMethod(Server:String;Port:integer;RequestData:String):String;
  function getHttpDataByPostMethod_2(Server:String;Port:integer;RequestData:String):String;

  function getXml(Action, User, Pwd: string; Ex: string = ''):String;
  procedure Submit(Action, User, Pwd: string; Ex: string = '');
implementation

function getXml(Action, User, Pwd: string; Ex: string = ''):String;
var
  Body: string;
begin
  Body := Format(REQUEST, [Action, User, Pwd, Ex]);
  Body := Format(HTTP, [mUrl.Server, mUrl.Port, Length(Body), Body]);
  Body := getHttpDataByPostMethod(mUrl.Server, mUrl.Port, Body);

  Result := Body;
end;

procedure Submit(Action, User, Pwd: string; Ex: string = '');
var
  Body: string;
begin
  Body := Format(REQUEST, [Action, User, Pwd, Ex]);
  Body := Format(HTTP, [mUrl.Server, mUrl.Port, Length(Body), Body]);
  Body := getHttpDataByPostMethod_2(mUrl.Server, mUrl.Port, Body);
end;

function getHttpDataByPostMethod(Server:String;Port:integer;RequestData:String):String;
var
  len,s:integer;
  name:sockaddr_in;
  he:PHostEnt;
  buf:array[0..1023]of char;
  str,data:string;
  wsd:WSADATA;
begin
  WSAStartup($101,wsd);
  s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  he:=gethostbyname(PChar(Server));
  if he=nil then
    Raise Exception.Create('使用Sock连接异常或是指定服务器有误!');

  FillChar(name,sizeof(name),0);
  name.sin_family:=AF_INET;
  name.sin_port:=htons(Port);
  name.sin_addr.S_addr:=PDWORD(PDWORD(he.h_addr)^)^;
  connect(s,name,sizeof(name));

  while (Length(RequestData) > 0) do
  begin
    str := LeftStr(RequestData, 1024);
    send(s,PChar(str)^,Length(str),0);
    if Length(RequestData) < 1025 then
      break
    else
      delete(RequestData, 1, 1024);
  end;

  while true do
  begin
    len:=recv(s,buf,sizeof(buf),0);
    if len<1 then
      break;
    SetString(str,buf,len);
    data:=data+str;
  end;
  closesocket(s);
  WSACleanup();

  len := Pos(#13#10#13#10, data);
  if len > 0 then
  begin
    Delete(data, 1, len + 4);
    data := Copy(data, Pos(#13#10, data)+2, Length(data)-10);
  end
  else
    data := '';
  data := UTF8Decode(data);
  Result := StringReplace(data, 'utf-8', 'gb2312', [rfReplaceAll]);
end;

function getHttpDataByPostMethod_2(Server:String;Port:integer;RequestData:String):String;
var
  s:integer;
  name:sockaddr_in;
  he:PHostEnt;
  str,data:string;
  wsd:WSADATA;
begin
  WSAStartup($101,wsd);
  s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
  he:=gethostbyname(PChar(Server));
  if he=nil then
    Raise Exception.Create('使用Sock连接异常或是指定服务器有误!');

  FillChar(name,sizeof(name),0);
  name.sin_family:=AF_INET;
  name.sin_port:=htons(Port);
  name.sin_addr.S_addr:=PDWORD(PDWORD(he.h_addr)^)^;
  connect(s,name,sizeof(name));

  while (Length(RequestData) > 0) do
  begin
    str := LeftStr(RequestData, 1024);
    send(s,PChar(str)^,Length(str),0);
    if Length(RequestData) < 1025 then
      break
    else
      delete(RequestData, 1, 1024);
  end;

  closesocket(s);
  WSACleanup();
  Result := data;

end;

end.