You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

100 lines
1.9 KiB
Plaintext

unit u_get56Cookie;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ExtCtrls;
type
Tfrmget56Cookie = class(TForm)
wb1: TWebBrowser;
procedure wb1DocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure FormShow(Sender: TObject);
private
function GetCookie(host: string): string;
{ Private declarations }
public
{ Public declarations }
end;
var
frmget56Cookie: Tfrmget56Cookie;
implementation
uses u_op_seae_edi_data;
{$R *.dfm}
{ Tfrmget56Cookie }
function Tfrmget56Cookie.GetCookie(host: string): string;
const
INTERNET_COOKIE_HTTPONLY = 8192;
var
hModule: THandle;
lp: Pointer;
InternetGetCookieEx: function(lpszUrl, lpszCookieName, lpszCookieData
: PAnsiChar; var lpdwSize: DWORD; dwFlags: DWORD; lpReserved: pointer)
: BOOL; stdCall;
CookieSize: DWORD;
CookieData: PAnsiChar;
begin
LoadLibrary('wininet.dll');
hModule := GetModuleHandle('wininet.dll');
if hModule <> 0 then
begin
@InternetGetCookieEx := GetProcAddress(hModule, 'InternetGetCookieExA');
if @InternetGetCookieEx <> nil then
begin
CookieSize := 1024;
Cookiedata := AllocMem(CookieSize);
if InternetGetCookieEx(PAnsiChar(AnsiString(host)), nil, Cookiedata, CookieSize, INTERNET_COOKIE_HTTPONLY, nil) then
result:=cookiedata;
FreeMem(Cookiedata);
end;
end;
end;
procedure Tfrmget56Cookie.wb1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var cookiestr:string;
begin
cookiestr:=GetCookie('http://56.qdcdc.com/cnm/Login.aspx');
frm_op_seae_edi_data.mmo1.Lines.Clear;
frm_op_seae_edi_data.mmo1.Lines.Add(cookiestr);
end;
procedure Tfrmget56Cookie.FormShow(Sender: TObject);
begin
wb1.Navigate('http://56.qdcdc.com/cnm/Login.aspx');
end;
end.