how can i call isapi dll from delphi application ?

{*******************************************************}
{                                                       }
{       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 ;

{ implémentation }

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 WebBrowser<>nil 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)+Index>High(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.