Mega Code Archive
Call isapi dll from application
<![CDATA[
Title: call isapi dll from application
Question: how can i call isapi dll from delphi application ?
Answer:
{*******************************************************}
{ }
{ Borland Delphi 5 }
{ Web server applications }
{ }
{ How to call ISAPI DLL from application }
{ using GET method }
{ }
{ By Noamen BELHAJ BETTAIEB }
{ (noamen.belhaj_bettaieb@centraliens.net) }
{ }
{*******************************************************}
{ u have simply to do this :
ISAPIManipulator:=TISAPIManipulator.Create (isapi_file_name,WebBrowser,[tmp_folder]); // initialize the object
ISAPIManipulator.Navigate (pathinfo,params); // call the dll and save the response in a file
== ISAPIManipulator.ResponseFileName is the name of the file where the response is saved
where :
isapi_file_name : full filename of your isapi
WebBrowser : if u would like to view the response of your isapi
this parameter can be set to nil
tmp_folder : this parameter tells where the response of the dll will be saved.
this parameter can be set to '', in this case, the response will
be saved in the tmp folder (using the TMP Environment Variable)
Note : the file is named like the dll (ex noamen_isapi.dll == noamen_isapi.html)
pathinfo : must begin with '/' (ex : '/webaction1')
params : param1=value1¶m2=value2 ...
}
unit UManipISAPI;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ISAPIApp,isapi2,
StdCtrls,WebBroker,shdocvw,winsock,FileCtrl;
type
// fonctions provenant de la dll ISAPI
THttpExtensionProc = function (var ECB: TEXTENSION_CONTROL_BLOCK): DWORD; stdcall ;
TGetExtensionVersion = function (var Ver: THSE_VERSION_INFO): BOOL; stdcall ;
TTerminateExtension = function (dwFlags: DWORD): BOOL; stdcall ;
TWriteClientProc = function (ConnID: HCONN;Buffer: Pointer;var Bytes: DWORD;dwReserved: DWORD ): BOOL stdcall;
TReadClientProc = function (ConnID: HCONN;Buffer: Pointer;var Size: DWORD ): BOOL stdcall;
TGetServerVariableProc = function (hConn: HCONN;VariableName: PChar;Buffer: Pointer;var Size: DWORD ): BOOL stdcall;
TServerSupportFunctionProc = function (hConn: HCONN;HSERRequest: DWORD;Buffer: Pointer;Size: LPDWORD;DataType: LPDWORD ): BOOL stdcall;
TISAPIManipulator = class
private
hndDLLHandle: THandle;
WebBrowser : TWebBrowser;
HttpExtensionProc : THttpExtensionProc;
GetExtensionVersion : TGetExtensionVersion;
TerminateExtension : TTerminateExtension;
ECB : TEXTENSION_CONTROL_BLOCK ;
Ver : THSE_VERSION_INFO;
InitialPathEnvVar : String;
TmpFolder : String;
public
ResponseFileName : String;
ISAPIFileName : String;
ISAPIResponse : TStringList;
procedure UpdatePathEnvVar (const newValue : String);
procedure Navigate (const sPathInfo, sParams : String);
constructor Create (const sISAPIFileName : String ; DefaultWebBorwser : TWebBrowser ; const sTmpFolder : String = '');
destructor Destroy ;
end;
function LocalWriteClient (ConnID: HCONN;Buffer: Pointer;var Bytes: DWORD;dwReserved: DWORD ): BOOL stdcall;
function LocalReadClientProc (ConnID: HCONN;Buffer: Pointer;var Size: DWORD ): BOOL stdcall;
function LocalGetServerVariableProc (hConn: HCONN;VariableName: PChar;Buffer: Pointer;var Size: DWORD ): BOOL stdcall;
function LocalServerSupportFunctionProc (hConn: HCONN;HSERRequest: DWORD;Buffer: Pointer;Size: LPDWORD;DataType: LPDWORD ): BOOL stdcall;
function StringIndex (const SearchedExpr: string; Values : array of string) : Integer;
procedure SetSrvVar (const VarName, VarValue : String);
function GetSrvVarValue (const VarName:String):String;
function GetSrvVarIndex (const VarName:String):Integer;
const SrvVars_Names : array [0..23] of String = ( 'SERVER_PROTOCOL',
'URL',
'HTTP_CACHE_CONTROL',
'HTTP_DATE',
'HTTP_ACCEPT',
'HTTP_FROM',
'HTTP_HOST',
'HTTP_IF_MODIFIED_SINCE',
'HTTP_REFERER',
'HTTP_USER_AGENT',
'HTTP_CONTENT_ENCODING',
'CONTENT_TYPE',
'CONTENT_LENGTH',
'HTTP_CONTENT_VERSION',
'HTTP_DERIVED_FROM',
'HTTP_EXPIRES',
'HTTP_TITLE',
'REMOTE_ADDR',
'REMOTE_HOST',
'SCRIPT_NAME',
'SERVER_PORT',
'HTTP_CONNECTION',
'HTTP_COOKIE',
'HTTP_AUTHORIZATION');
var Response : TStringList;
type MyPChar = array [0..2048] of Char;
var SrvVars_Values : array of PChar ;
{ implmentation }
implementation
function GetLastSystemError : String;
var Msg : PChar;
begin
Msg:=PChar(LocalAlloc (LMEM_FIXED,254));
FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM,nil,GetLastError,0,Msg,254,nil);
Result:=StrPas(Msg);
end;
function GetEnvVar (const sVarName : String):String;
var Buff : PChar;
begin
Buff:=PChar(LocalAlloc (LMEM_FIXED,1024));
GetEnvironmentVariable (PChar(sVarName),Buff,1024);
Result:=StrPas(Buff);
end;
function StringIndex (const SearchedExpr: string; Values : array of string) : Integer;
var
i: Integer;
begin
Result := -1;
for i := Low(Values) to High(Values) do
if CompareText(SearchedExpr, Values[i])=0 then
begin
Result := i-Low(Values);
exit;
end;
end;
function Mygethostname (const bInitializing : Boolean = false) : String;
var P:PChar;
AData : WSADATA ;
begin
P:=PChar(LocalAlloc (LMEM_FIXED,1024));
if gethostname (P,1024)0 then
begin
P:='127.0.0.1';
case WSAGetLastError of
// WSAEFAULT : ShowMessage ('The name argument is not a valid part of the user address space, or the buffer size specified by namelen argument is too small to hold the complete host name.');
WSANOTINITIALISED : begin
// ShowMessage ('A successful WSAStartup must occur before using this function.');
if not bInitializing then
begin
WSAStartup (1,AData);
Result:=Mygethostname (true);
exit;
end;
end;
// WSAENETDOWN : ShowMessage ('The network subsystem has failed.');
// WSAEINPROGRESS : ShowMessage ('A blocking Windows Sockets 1.1 call is in progress, or the service provider is still processing a callback function.');
end;
end;
Result:=StrPas(P);
end;
procedure TISAPIManipulator.UpdatePathEnvVar (const newValue : String);
begin
SetEnvironmentVariable (PChar('PATH'),PChar(newValue));
end;
procedure TISAPIManipulator.Navigate (const sPathInfo, sParams : String);
begin
ECB.lpszMethod:=PChar('GET'); // REQUEST_METHOD
ECB.lpszQueryString:=PChar(sParams); // QUERY_STRING
ECB.lpszPathInfo:=PChar(sPathInfo); // PATH_INFO
ECB.lpszPathTranslated:=PChar(ExtractFilePath(ISAPIFileName)); // PATH_TRANSLATED
ECB.lpszContentType:=PChar(''); // Content type of client data
SetSrvVar('URL',ExtractFileName (ISAPIFileName));
SetSrvVar('SCRIPT_NAME',GetSrvVarValue('URL'));
ECB.cbTotalBytes:=0;
ECB.cbAvailable:=0;
ECB.lpbData:=PChar('');
ECB.cbSize:=SizeOf (ECB);
HttpExtensionProc (ECB);
ISAPIResponse.Clear;
ISAPIResponse.AddStrings(Response);
if DirectoryExists (TmpFolder) then
begin
ResponseFileName:=TmpFolder+ExtractFileName(ChangeFileExt(ISAPIFileName,'.html'));
ISAPIResponse.SaveToFile (ResponseFileName);
end;
if WebBrowsernil then
begin
WebBrowser.Navigate (ResponseFileName);
end;
end;
destructor TISAPIManipulator.Destroy ;
begin
UpdatePathEnvVar (InitialPathEnvVar);
TerminateExtension (0);
freeLibrary (hndDLLHandle);
ISAPIResponse.Free;
inherited Destroy;
end;
constructor TISAPIManipulator.Create (const sISAPIFileName : String ; DefaultWebBorwser : TWebBrowser ; const sTmpFolder : String = '');
var LocalInitialPathEnvVar : String;
begin
if not FileExists (sISAPIFileName)
then Raise Exception.Create ('DLL not found ..');
if CompareText ('.DLL',ExtractFileExt (sISAPIFileName))0
then Raise Exception.Create ('"'+sISAPIFileName+'" is not a valid DLL ..');
inherited Create;
ISAPIFileName:=sISAPIFileName;
ISAPIResponse:=TStringList.Create;
WebBrowser:=DefaultWebBorwser;
InitialPathEnvVar:=GetEnvVar ('path');
ResponseFileName:='';
TmpFolder:=sTmpFolder;
if not DirectoryExists (TmpFolder) then
begin
TmpFolder:=GetEnvVar ('TMP');
end;
if TmpFolder''
then if TmpFolder[length(TmpFolder)]'\'
then TmpFolder:=TmpFolder+'\';
LocalInitialPathEnvVar:=InitialPathEnvVar;
try
if LocalInitialPathEnvVar''
then if LocalInitialPathEnvVar[length(LocalInitialPathEnvVar)]';'
then LocalInitialPathEnvVar:=LocalInitialPathEnvVar+';';
UpdatePathEnvVar (LocalInitialPathEnvVar+ExtractShortPathName(ExtractFilePath(sISAPIFileName)));
hndDLLHandle:=loadLibrary (PChar(ISAPIFileName));
if hndDLLHandle 0 then
begin
try
// HttpExtensionProc
@HttpExtensionProc := getProcAddress (hndDLLHandle,'HttpExtensionProc');
if addr (HttpExtensionProc) = nil
then Raise Exception.Create ('"'+sISAPIFileName+'"'+' seems to be a non valid ISAPI DLL : '#13+
'Function HttpExtensionProc not exists..');
// GetExtensionVersion
@GetExtensionVersion := getProcAddress (hndDLLHandle,'GetExtensionVersion');
if addr (GetExtensionVersion) = nil
then Raise Exception.Create ('"'+sISAPIFileName+'"'+' seems to be a non valid ISAPI DLL : '#13+
'Function GetExtensionVersion not exists..');
// TerminateExtension
@TerminateExtension := getProcAddress (hndDLLHandle,'TerminateExtension');
if addr (TerminateExtension) = nil
then Raise Exception.Create ('"'+sISAPIFileName+'"'+' seems to be a non valid ISAPI DLL : '#13+
'Function TerminateExtension not exists..');
except
freeLibrary (hndDLLHandle);
Raise;
end;
end else
begin
Raise Exception.Create ('DLL not found...'#13+GetLastSystemError);
end;
FillChar(Ver.lpszExtensionDesc,SizeOf(Ver.lpszExtensionDesc),0);
GetExtensionVersion (Ver);
ECB.dwVersion:=Ver.dwExtensionVersion;
FillChar (ECB.lpszLogData,SizeOf (ECB.lpszLogData),0);
ECB.lpszLogData:='log';
ECB.lpszMethod:=PChar('GET'); // REQUEST_METHOD
ECB.WriteClient:=LocalWriteClient ;
ECB.ReadClient:=LocalReadClientProc;
ECB.GetServerVariable:=LocalGetServerVariableProc;
ECB.ServerSupportFunction:=LocalServerSupportFunctionProc;
except
on E:Exception do
begin
UpdatePathEnvVar (InitialPathEnvVar);
Raise Exception.Create (E.Message);
end;
end;
end;
function LocalWriteClient ( ConnID: HCONN;Buffer: Pointer;var Bytes: DWORD;dwReserved: DWORD ): BOOL stdcall;
Var S:WideString;
begin
Response.Clear;
SetString(S, PChar(Buffer), bytes);
// Response.Text:=StrPas(Buffer);
Response.Text:=S;
Result:=True;
end;
function LocalReadClientProc ( ConnID: HCONN;Buffer: Pointer;var Size: DWORD ): BOOL stdcall;
begin
FillChar(Buffer,Size,0);
Result:=True;
end;
function LocalGetServerVariableProc ( hConn: HCONN;VariableName: PChar;Buffer: Pointer;var Size: DWORD ): BOOL stdcall;
var Index:Integer;
begin
Index:=GetSrvVarIndex (StrPas(VariableName));
if Index=-1
then exit;
StrCopy (Buffer,SrvVars_Values[Index]);
Size:=Length (SrvVars_Values[Index])+1;
Result:=True;
end;
function LocalServerSupportFunctionProc ( hConn: HCONN;HSERRequest: DWORD;Buffer: Pointer;Size: LPDWORD;DataType: LPDWORD ): BOOL stdcall;
begin
Result:=True;
end;
procedure SetSrvVar (const VarName, VarValue : String);
var Index:Integer;
begin
Index:=GetSrvVarIndex (VarName);
if Index=-1
then exit;
if low(SrvVars_Values)+IndexHigh(SrvVars_Values)
then exit;
StrCopy (SrvVars_Values[low(SrvVars_Values)+Index],PChar(VarValue));
// SrvVars_Values[low(SrvVars_Values)+Index]:=PChar(VarValue);
end;
function GetSrvVarValue (const VarName:String):String;
var Index:Integer;
begin
Result:='';
Index:=GetSrvVarIndex (VarName);
if not (Index in [low(SrvVars_Values)..High(SrvVars_Values)])
then exit;
Result:=StrPas (SrvVars_Values[Index]);
end;
function GetSrvVarIndex (const VarName:String):Integer;
begin
Result:=StringIndex (VarName,SrvVars_Names);
end;
procedure Init_SrvVars_Values ;
var i:Integer;
begin
for i:=low(SrvVars_Values) to High(SrvVars_Values)
do SrvVars_Values[i]:=PChar(GlobalAlloc(GMEM_FIXED,4096));
end;
initialization
Response:=TStringList.Create;
SetLength(SrvVars_Values,length(SrvVars_Names));
Init_SrvVars_Values ;
// remplissage de SrvVars_Values
SetSrvVar ('SERVER_PROTOCOL','HTTP/1.1');
SetSrvVar ('URL',''); //
SetSrvVar ('HTTP_CACHE_CONTROL','');
SetSrvVar ('HTTP_DATE',DateToStr(Now));
SetSrvVar ('HTTP_ACCEPT','image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-powerpoint, application/vnd.ms-excel, application/msword, */*');
SetSrvVar ('HTTP_FROM','');
SetSrvVar ('HTTP_HOST',Mygethostname);
SetSrvVar ('HTTP_IF_MODIFIED_SINCE','');
SetSrvVar ('HTTP_REFERER','');
SetSrvVar ('HTTP_USER_AGENT','Mozilla/4.0 (compatible; MSIE 5.5; Windows NT 5.0; T312461; .NET CLR 1.0.3705)');
SetSrvVar ('HTTP_CONTENT_ENCODING','');
SetSrvVar ('CONTENT_TYPE','');
SetSrvVar ('CONTENT_LENGTH',IntToStr(Length(GetSrvVarValue('CONTENT_TYPE'))));
SetSrvVar ('HTTP_CONTENT_VERSION','');
SetSrvVar ('HTTP_DERIVED_FROM','');
SetSrvVar ('HTTP_EXPIRES',DateToStr(Now));
SetSrvVar ('HTTP_TITLE','');
SetSrvVar ('REMOTE_ADDR',Mygethostname);
SetSrvVar ('REMOTE_HOST',Mygethostname);
SetSrvVar ('SCRIPT_NAME',''); // comme URL
SetSrvVar ('SERVER_PORT','80');
SetSrvVar ('HTTP_CONNECTION','Keep-Alive');
SetSrvVar ('HTTP_COOKIE','');
SetSrvVar ('HTTP_AUTHORIZATION','Negotiate TlRMTVNTUAADAAAAAAAAAEAAAAAAAAAAQAAAAAAAAABAAAAAAAAAAEAAAAAAAAAAQAAAAAAAAABAAAAABcKAoE==');
finalization
Response.Free;
end.
]]>