Le but de ce didactitiel est de vous faire découvrir pas à pas, la construction d'une application pour le web avec Delphi 6. Il ne sera pas question ici, de faire le tour des technologies et possibilités offertes par la dernière version de l'outil de programmation, mais simplement de vous donner la marche à suivre pour créer une application portable.

unit uCustomDllObject;
interface

Uses Windows, Messages, SysUtils, Classes;
Type
  TBaseObject = Class
   fslError   : TStringList;      // Liste des erreurs
   fRepDatas : String;
    Private
      function GetModuleName : string;
      function GetModulePath : String;
      function GetErrorsHtm : String;
    Public
      Constructor Create;
      Destructor Destroy; Override;
      Procedure AddError(sError : String);
      Function ReplaceTag(Var MyString : String;TagStr,NewValue: String ):Integer;
      function LoadTxtFile(aFile: String): String;
      function SetFilePath(aFileName : String):String;
      function TranslateChar(const Str: string; FromChar, ToChar: Char): string;
      function UnixPathToDosPath(const Path: string): string;
      Function SetCr2Br(sText:String) : String;
      Function SeekLinks(sText:String):String;

      Property ModuleName : String Read GetModuleName;
      Property ModulePath : String Read GetModulePath;
      Property Errors : TStringList Read fslError;
      Property ErrorsISAPIHtm : String Read GetErrorsHtm;
      Property repData : String Read fRepDatas Write fRepDatas;
  End;

implementation
Const
  cRepData = 'datas\'; // repertoire par défaut des données à lire et à écrire

{ TBaseObject }

procedure TBaseObject.AddError(sError: String);
begin
  // Ajoute à la liste des erreurs
   fslError.add(sError);
end;

constructor TBaseObject.Create;
begin
  inherited Create;
  fslError:=TStringList.Create;
  fRepDatas:=ModulePath+cRepData;
end;

destructor TBaseObject.Destroy;
begin
  inherited;
  fslError.Free;
end;

function TBaseObject.GetModuleName: string;
var
  ModName: array[0..MAX_PATH] of Char;
begin
  SetString(Result, ModName, 
   Windows.GetModuleFileName(HInstance, ModName, SizeOf(ModName)));
end;

function TBaseObject.GetModulePath: String;
begin
  Result:=ExtractFilePath(ModuleName);
end;

Function TBaseObject.ReplaceTag(Var MyString : String;
                TagStr,NewValue: String ):Integer;
Var FoundAt : Integer;
    LenTag : Integer;
    Count : Integer;
begin
  Count:=0;
  LenTag := Length(TagStr);
  TagStr:=LowerCase(TagStr);
  FoundAt := Pos(TagStr,LowerCase(MyString));
  While FoundAt>0 do
  begin
    System.Delete(MyString,FoundAt,LenTag);
    System.insert(NewValue,MyString,FoundAt);
    inc(Count);
    FoundAt := Pos(TagStr,LowerCase(MyString));
  end;
  Result:=Count;
end;

function TBaseObject.TranslateChar(const Str: string; 
                FromChar, ToChar: Char): string;
var
  I: Integer;
begin
  Result := Str;
  if Pos(FromChar,Str)>0 then
  for I := 1 to Length(Result) do
    if Result[I] = FromChar then
      Result[I] := ToChar;
end;

function TBaseObject.UnixPathToDosPath(const Path: string): string;
begin
  Result := TranslateChar(Path, '/', '\');
end;

function TBaseObject.SetFilePath(aFileName: String): String;
begin
  aFileName:=UnixPathToDosPath(aFileName);
  if FileExists(ExpandFileName(aFileName)) then
   Result:=ExpandFileName(aFileName)
  else
   Result:=fRepDatas+aFileName;
end;

function TBaseObject.LoadTxtFile(aFile: String): String;
Var T : TStringList;
begin
  Result:='';
  if Trim(aFile)<>'' then
  begin
    if FileExists(aFile) then
    begin
      T:=TStringList.Create;
      Try
	Try
	 T.LoadFromFile(afile);
	 Result:=T.Text;
	Except
	 On e:Exception do
	  AddError('TBaseObject.LoadTxtFile : Erreur durant la lecture du fichier '+
                 afile+#13+e.message);
	end;
      Finally
       T.Free;
      end;
    end
    else
     AddError('TBaseObject.LoadTxtFile : Le fichier '+aFile+' n''existe pas');
  end
  else
   AddError('TBaseObject.LoadTxtFile : Le nom de fichier est vide');
end;

function TBaseObject.GetErrorsHtm: String;
begin
  Result:=SetCr2Br(fslError.text);
end;

Function TBaseObject.SetCr2Br(sText:String) : String;
Var i : Integer;
    T : TStringList;
begin
  // Effectue une présentation compatible avec Htm
  T:=TstringList.create;
  Try
    T.Text:=sText;
    sText:='';
    For i:=0 to T.Count-1 do
     sText:=sText+T[i]+'<BR>';
  finally
   T.Free;
   Result:=sText;
  end;
end;

function TBaseObject.SeekLinks(sText: String): String;
Var i,j : Integer;
    Temp : String;
begin
  // Cherche les liens dans le corps du mail.
  // fonction très sommaire !
  i:=Pos('http://',LowerCase(sText));
  Try
    if Pos('a href',LowerCase(sText))<>0 then exit;
    While i>6 do
    begin
      j:=i;
      While (sText[j]<>' ') and (sText[j]<>#13) 
                                         and (j<Length(sText)) 
                                         do inc(j);
       if (j>0) and (j<=Length(sText)) then
       begin
	 Temp:=Copy(sText,i,j-i);
	 System.delete(sText,i,j-i);
	 System.Insert('<A HREF="'+Temp+'">'+Temp+'</A>',sText,i);
       end;
      i:=Pos('http://',LowerCase(sText));
      if i<=J then Exit;
    end;
  Finally
    Result:=sText;
  end;
end;

end.