unit GenerateHeaderUnit;

Classes , SysUtils, APIFileReader, ProgramConstants;

AllHeadersUnitName = 'AllHeaders';

DefaultLibNamePrefix = 'C';

HeaderSrcFilter = '*.h2pas';

{ TGenerateAPIUnit }

TGenerateAPIUnit = class(TAPIFileReader)

private

FCopyFilePrefix : string;

FLibNamePrefix : string;

FRemovedFunctions: TStrings;

FCompatibilityFunctions: TStrings;

FLegacySupportFunctions: TStrings;

FLibName: string;

FUnitPrefix : string;

FUnitNames: TStrings;

FCopyUnitNames: TStrings;

FOutFile: TStrings;

FCopyingFiles: boolean;

FIncludeFiles: TStrings;

function GetLibNameForUnit: string;

procedure AddExFunctionVersionInfo(S: TStrings);

procedure AddIncludeList(S: TStrings);

procedure AnalyseExternalFunctions;

procedure CopyFile(aFileName,destFileName: string);

procedure DoCopyFile(aFileName: string; destDir: string);

procedure DoCopyFiles(copyFiles: TStrings; destDir: string); overload;

procedure DoCopyFiles(copyFilesFromDir: string; destDir: string); overload;

function FindFirstFunction(list: TList): integer;

procedure GetUnitNamesList(SourceDir: string; filter: string);

protected type

TLegacyCallType = (lcAllLegacy, lcAllowNilAndRemoved, lcRemovedNotAllowNil,

lcRemovedHasCompatibility, lcRemovedNoCompatibility);

protected

procedure AddErrorFunctions(S : TStrings); virtual; abstract;

procedure AddDynamicLoadInit(S: TStrings); virtual; abstract;

procedure AddDynamicInterfaceSection(S : TStrings; firstFuncProc : integer); virtual;

procedure AddDynamicLegacyCalls(S : TStrings; firstFuncProc : integer; callType: TLegacyCallType);

procedure AddStaticInterfaceSection(S : TStrings; firstFuncProc : integer); virtual;

procedure AddDynamicImplementationSection(S: TStrings; firstFuncProc: integer); virtual;

function DoFixUp(useUnit: string): string; override;

function GenerateInterfaceSection(S : TStrings) : boolean;

procedure GenerateImplementationSection(S: TStrings);

function GetImplementationUses: string; virtual;

function GetInitialiser(funcProc: IFuncProcInfo): string; virtual; abstract;

function GetUnitName(aUnitName: string):string; override;

procedure DoGenerateUnit(sourceFileName,destfileName: string);

procedure AddLoadFunctions(S : TStrings); virtual; abstract;

procedure AddUnLoadFunctions(S : TStrings); virtual; abstract;

procedure PeekSaveLine(var aLine: string); override;

procedure SetExternalLibName(aLibName: string); override;

public

constructor Create;

destructor Destroy; override;

procedure Clear; override;

procedure GenerateHeaderUnitFrom(sourceFilename, destDir:string; aLibName: string='');

procedure GenerateHeaderUnitFromDir(sourceDir, destDir: string; copyFiles: TStrings; aLibName: string= '');

property CopyFilePrefix: string read FCopyFilePrefix write FCopyFilePrefix;

property LibName: string read FLibName;

property LibNamePrefix: string read FLibNamePrefix write FLibNamePrefix;

property RemovedFunctions: TStrings read FRemovedFunctions;

property CompatibilityFunctions: TStrings read FCompatibilityFunctions;

property LegacySupportFunctions: TStrings read FLegacySupportFunctions;

property UnitPrefix: string read FUnitPrefix write FUnitPrefix;

end;

uses Tokeniser;

sUnitIntro = '(* This unit was generated from the source file %s ' + LineEnding +

'It should not be modified directly. All changes should be made to %s' + LineEnding +

'and this file regenerated *)' + LineEnding + LineEnding;

sExternalSymIntro = '{ The EXTERNALSYM directive is ignored by FPC, however, it is used by Delphi as follows: ' +

LineEnding + LineEnding +

'The EXTERNALSYM directive prevents the specified Delphi symbol from appearing in header ' + LineEnding +

'files generated for C++. }' + LineEnding + LineEnding;

resourcestring

RSOHelpersInConditional = 'Helper Function section cannot be within a conditional section';

RSOGeneratingUnit = 'Generating Unit File to %s';

RSOCopyFile = 'Copying %s to %s';

function TGenerateAPIUnit.GetLibNameForUnit : string;

Result := CryptoLibName

end;

procedure TGenerateAPIUnit.AddExFunctionVersionInfo(S : TStrings);

var needsConst: boolean;

i: integer;

{const declarations for each External Function Introduced and Removed Versions}

needsConst := true;

with InterfaceSection do

begin

for i := 0 to Count - 1 do

if TObject(Items[i]) is IFuncProcInfo then

with TObject(Items[i]) as IFuncProcInfo do

begin

if NeedsConst and ((IntroducedVersion <> '') or (RemovedVersion <> '')) then

begin

S.Add('const');

NeedsConst := false;

end;

if IntroducedVersion <> '' then

S.Add(' ' + ProcName + '_introduced = ' + IntroducedVersion + '; {' + GetIntroducedIn + '}');

if RemovedVersion <> '' then

S.Add(' ' + ProcName + '_removed = ' + RemovedVersion + '; {' + GetRemovedIn + '}');

end;

if not needsConst then

S.Add('');

end;

end;

procedure TGenerateAPIUnit.AddIncludeList(S : TStrings);

var i: integer;

for i := 0 to FIncludeFiles.Count - 1 do

S.Add('{$i ' + CopyFilePrefix + FIncludeFiles[i] + '}');

if FIncludeFiles.Count > 0 then

S.Add('');

end;

procedure TGenerateAPIUnit.AnalyseExternalFunctions;

var i: integer;

with InterfaceSection do

begin

for i := 0 to Count - 1 do

begin

if TObject(Items[i]) is IFuncProcInfo then

with TObject(Items[i]) as IFuncProcInfo do

if Removed then

FRemovedFunctions.AddObject(ProcName,TObject(Items[i]))

end;

end;

with ImplementationSection do

begin

for i := 0 to Count - 1 do

begin

if TObject(Items[i]) is IFuncProcInfo then

with TObject(Items[i]) as IFuncProcInfo do

begin

if RemovedFunctions.IndexOf(ProcName) <> -1 then

FLegacySupportFunctions.AddObject(ProcName, TObject(Items[i]));

FCompatibilityFunctions.AddObject(ProcName,TObject(Items[i]));

end;

end;

end;

end;

procedure TGenerateAPIUnit.CopyFile(aFileName , destFileName : string);

var S, D: TStream;

S := TFileStream.Create(aFileName,fmOpenRead);

D := TFileStream.Create(destFileName,fmCreate);

try

D.CopyFrom(S,0);

finally

S.Free;

D.Free;

end;

end;

procedure TGenerateAPIUnit.DoCopyFile(aFileName : string; destDir : string);

var destFileName: string;

if UpperCase(ExtractFileExt(aFileName)) = '.PAS' then

begin

destFileName := destDir + DirectorySeparator + CopyFilePrefix + ExtractFileName(aFileName);

FOutFile := TStringList.Create;

try

if not FGetUnitNamesPass then

AddIncludeList(FOutFile);

ReadAPIHeaderFile(aFileName); {rely on PeekSaveLine to copy updated lines}

if not FGetUnitNamesPass then

begin

FOutFile.SaveToFile(destFileName

{$IFNDEF FPC},TEncoding.UTF8{$ENDIF});

DoWriteLine(Format(RSOCopyFile,[aFileName, destFileName]));

end

else

FCopyUnitNames.Add(Uppercase(UnitName));

finally

FreeAndNil(FOutFile);

end;

end

else

if FGetUnitNamesPass then

begin

if UpperCase(ExtractFileExt(aFileName)) ='.INC' then

FIncludeFiles.Add(ExtractFileName(aFileName));

end

else

begin

if UpperCase(ExtractFileExt(aFileName)) ='.INC' then

destFileName := destDir + DirectorySeparator + CopyFilePrefix + ExtractFileName(aFileName)

else

destFileName := destDir + DirectorySeparator + ExtractFileName(aFileName);

CopyFile(aFileName,destFileName);

DoWriteLine(Format(RSOCopyFile,[aFileName, destFileName]));

end;

end;

procedure TGenerateAPIUnit.DoCopyFiles(copyFiles : TStrings; destDir : string

);

var i: integer;

FCopyingFiles := true;

try

{Get Unit Names for all files}

FGetUnitNamesPass := true;

try

for i := 0 to copyFiles.Count - 1 do

begin

if DirectoryExists(copyFiles[i]) then

DoCopyFiles(copyFiles[i],destDir)

else

DoCopyFile(copyFiles[i],destDir);

end;

finally

FGetUnitNamesPass := false;

end;

{Now do the actual copy}

for i := 0 to copyFiles.Count - 1 do

begin

if DirectoryExists(copyFiles[i]) then

DoCopyFiles(copyFiles[i],destDir)

else

DoCopyFile(copyFiles[i],destDir);

end;

finally

FCopyingFiles := false;

end;

end;

procedure TGenerateAPIUnit.DoCopyFiles(copyFilesFromDir : string;

destDir : string);

var token: TSearchRec;

if FindFirst(copyFilesFromDir + DirectorySeparator + '*',0,token) = 0 then

try

repeat

if not DirectoryExists(copyFilesFromDir + DirectorySeparator + token.name) then

DoCopyFile(copyFilesFromDir + DirectorySeparator + token.name,destDir);

until FindNext(token) <> 0;

finally

FindClose(token);

end;

end;

function TGenerateAPIUnit.FindFirstFunction(list : TList) : integer;

var ConditionalLevel: integer;

LastConditionalLevel0Directive: integer;

i: integer;

ConditionalLevel := 0;

LastConditionalLevel0Directive := -1;

with list do

begin

Result := Count;

{find first external function or opening conditional directive for first function}

for i := 0 to Count - 1 do

begin

if TObject(Items[i]) is TDirective then

begin

with TObject(Items[i]) as TDirective do

if Pos('IF',UpperCase(Name)) = 1 then

begin

if ConditionalLevel = 0 then

LastConditionalLevel0Directive := i;

Inc(ConditionalLevel);

end

else

if (UpperCase(Name) = 'ENDIF') or (UpperCase(Name) = 'IFEND') then

Dec(ConditionalLevel);

end

else

if (TObject(Items[i]) is THelperFunctions) and (ConditionalLevel <> 0) then

raise Exception.Create(RSOHelpersInConditional)

else

if TObject(Items[i]) is IFuncProcInfo then

begin

if ConditionalLevel = 0 then

Result := i

else

Result := LastConditionalLevel0Directive;

break;

end;

end;

end;

end;

procedure TGenerateAPIUnit.GetUnitNamesList(SourceDir : string;

filter : string);

var token: TSearchRec;

if FindFirst(SourceDir + DirectorySeparator + filter,0,token) = 0 then

try

FGetUnitNamesPass := true;

repeat

ReadAPIHeaderFile(SourceDir + DirectorySeparator + token.Name);

FUnitNames.Add(UpperCase(UnitName));

Clear;

until FindNext(token) <> 0;

finally

FindClose(token);

FGetUnitNamesPass := false;

end;

end;

procedure TGenerateAPIUnit.AddDynamicInterfaceSection(

S : TStrings; firstFuncProc : integer);

var i: integer;

needsVar: boolean;

AllowNilFunctionCount: integer;

needsVar := true;

AllowNilFunctionCount := 0;

{Add functions for current version}

with InterfaceSection do

begin

for i := firstFuncProc to Count - 1 do

begin

if TObject(Items[i]) is THelperFunctions then

continue

else

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if TObject(Items[i]) is IFuncProcInfo then

begin

with TObject(Items[i]) as IFuncProcInfo do

begin

if not Removed then

begin

if needsVar then

begin

S.Add('var');

needsVar := false;

end;

S.Add(' ' + GetVarDeclaration(GetInitialiser(TObject(Items[i]) as IFuncProcInfo)));

end

else

if AllowNil then

Inc(AllowNilFunctionCount);

end;

end

else

if TObject(Items[i]) is TStrings then

S.AddStrings(TStrings(Items[i])) {types, vars, comments, etc embedded in API declarations}

end;

end;

if (LegacySupportFunctions.Count = 0) and (AllowNilFunctionCount = 0) then

Exit;

{Add Legacy Functions}

S.Add('');

S.Add('{Removed functions for which legacy support available - use is deprecated}');

S.Add('');

AddDynamicLegacyCalls(S,firstFuncProc,lcRemovedHasCompatibility);

end;

procedure TGenerateAPIUnit.AddDynamicLegacyCalls(S : TStrings;

firstFuncProc : integer; callType : TLegacyCallType);

function Selected(funcProc: IFuncProcInfo): boolean;

begin

with funcProc do

case callType of

lcAllLegacy:

Result := Removed;

lcAllowNilAndRemoved:

Result := (LegacySupportFunctions.IndexOf(ProcName) <> -1) or (AllowNil and Removed);

lcRemovedNotAllowNil:

Result := (LegacySupportFunctions.IndexOf(ProcName) = -1) and Removed and not AllowNil;

lcRemovedHasCompatibility:

Result := Removed and (LegacySupportFunctions.IndexOf(ProcName) <> -1);

lcRemovedNoCompatibility:

Result := Removed and (LegacySupportFunctions.IndexOf(ProcName) = -1);

end;

end;

var i: integer;

needsVar: boolean;

needsVar := true;

S.Add('{$IFNDEF ' + NoLegacySupportSymbol + '}');

with InterfaceSection do

begin

for i := firstFuncProc to Count - 1 do

begin

if TObject(Items[i]) is THelperFunctions then

continue

else

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if TObject(Items[i]) is IFuncProcInfo then

begin

if Selected(TObject(Items[i]) as IFuncProcInfo) then

with TObject(Items[i]) as IFuncProcInfo do

begin

if needsVar then

begin

S.Add('var');

needsVar := false;

end;

S.Add(' ' + GetVarDeclaration(GetInitialiser(TObject(Items[i]) as IFuncProcInfo)) );

end;

end

end;

end;

S.Add('{$ENDIF} { End of ' + NoLegacySupportSymbol + '}');

end;

procedure TGenerateAPIUnit.AddStaticInterfaceSection(S : TStrings;

firstFuncProc : integer);

var i: integer;

with InterfaceSection do

begin

for i := firstFuncProc to Count - 1 do

begin

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if TObject(Items[i]) is IFuncProcInfo then

begin

with TObject(Items[i]) as IFuncProcInfo do

if not Removed then

S.Add(GetExternalDeclaration + ' external ' + LibNamePrefix + LibName + ';');

end

else

if TObject(Items[i]) is THelperFunctions then

continue

else

if TObject(Items[i]) is TStrings then

S.AddStrings(TStrings(Items[i])) {types, vars, comments, etc embedded in API declarations}

end;

S.Add('');

if LegacySupportFunctions.Count > 0 then

begin

S.Add('{Removed functions for which legacy support available - use is deprecated}');

S.Add('');

S.Add('{$IFNDEF ' + NoLegacySupportSymbol + '}');

for i := firstFuncProc to Count - 1 do

begin

if TObject(Items[i]) is THelperFunctions then

continue

else

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if TObject(Items[i]) is IFuncProcInfo then

begin

with TObject(Items[i]) as IFuncProcInfo do

begin

if Removed and (LegacySupportFunctions.IndexOf(ProcName) <> -1) then

S.Add(GetExternalDeclaration);

end;

end

end;

S.Add('{$ENDIF} { End of ' + NoLegacySupportSymbol + '}');

end;

end;

end;

procedure TGenerateAPIUnit.AddDynamicImplementationSection(S : TStrings;

firstFuncProc : integer);

var i, j: integer;

{Now add each Compatibility Functions}

S.Add('{$IFNDEF ' + NoLegacySupportSymbol + '}');

with ImplementationSection do

for i := firstFuncProc to Count - 1 do

begin

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if (TObject(Items[i]) is IFuncProcInfo) then

begin

j := CompatibilityFunctions.IndexOfObject(TObject(Items[i]));

if j <> -1 then

with CompatibilityFunctions.Objects[j] as IFuncProcInfo do

begin

if isFunction then

S.Add('function COMPAT_' + ProcName + ProcHeader + ': ' + ResultType + '; cdecl;')

else

S.Add('procedure COMPAT_' + ProcName + ProcHeader + '; cdecl;');

S.AddStrings(FunctionBody);

S.Add('');

end;

end;

end;

S.Add('{$ENDIF} { End of ' + NoLegacySupportSymbol + '}');

end;

function TGenerateAPIUnit.DoFixUp(useUnit : string) : string;

if FUnitNames.IndexOf(UpperCase(useUnit)) <> -1 then

Result := UnitPrefix + useUnit

else

if FCopyUnitNames.IndexOf(UpperCase(useUnit)) <> -1 then

Result := CopyFilePrefix + useUnit

else

Result := inherited DoFixUp(useUnit);

end;

function TGenerateAPIUnit.GenerateInterfaceSection(S : TStrings): boolean;

var i: integer;

firstFuncProc: integer;

HasHelpers: boolean;

Result := true;

HasHelpers := true;

firstFuncProc := FindFirstFunction(InterfaceSection);

with InterfaceSection do

begin

{Copy everything up to first function/procedure}

for i := 0 to firstFuncProc - 1 do

begin

if TObject(Items[i]) is THelperFunctions then

HasHelpers := true;

if TObject(Items[i]) is TStrings then

S.AddStrings(TStrings(Items[i]))

else

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}');

end;

Result := (firstFuncProc < Count) or HasHelpers;

if not Result then

Exit; {otherwise ignore files without a procedure/function definition}

{copy any more helper functions from interface section}

for i := firstFuncProc to Count - 1 do

if TObject(Items[i]) is THelperFunctions then

S.AddStrings(THelperFunctions(Items[i]));

{Add EXTERNALSYM directive for each function/procedure not removed in most recent version of OpenSSL}

AddText(S,sExternalSymIntro);

for i := firstFuncProc to Count - 1 do

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if TObject(Items[i]) is IFuncProcInfo then

with TObject(Items[i]) as IFuncProcInfo do

if not Removed then

S.Add('{$EXTERNALSYM ' + ProcName + '}');

S.Add('');

{Generate static library interface}

S.Add('{$IFDEF ' + StaticLinkModel + '}');

AddStaticInterfaceSection(S,firstFuncProc);

S.Add('{$ELSE}');

{Generate Dynamic library interface}

AddDynamicInterfaceSection(S,firstFuncProc);

S.Add('{$ENDIF}');

AddExFunctionVersionInfo(S);

end;

end;

procedure TGenerateAPIUnit.GenerateImplementationSection(S : TStrings);

var i,j: integer;

hasUses: boolean;

firstFuncProc: integer;

hasUses := false;

firstFuncProc := FindFirstFunction(ImplementationSection);

with ImplementationSection do

begin

{Is there a uses clause in the source?}

for i := 0 to firstFuncProc -1 do

if (TObject(Items[i]) is TUsesClause) then

begin

hasUses := true;

break;

end;

end;

{Find uses and compatibility functions and include all else other than Helper functions}

with ImplementationSection do

for i := 0 to firstFuncProc - 1 do

begin

// writeln(i,',',TObject(Items[i]).ClassName);

if TObject(Items[i]) is TPlainText then

S.AddStrings(TStrings(Items[i]))

else

if TObject(Items[i]) is TDirective then

with TDirective(Items[i]) do

S.Add('{$' + Name + Condition + '}')

else

if (TObject(Items[i]) is TUsesClause) then

begin

{Add extra uses to uses clause}

with TObject(Items[i]) as TUsesClause do

begin

for j := 0 to Count - 1 do

if Pos(';',Strings[j]) = 0 then

S.Add(Strings[j])

else

begin

S.Add(StringReplace(Strings[j],';',',',[]));

self.AddText(S,GetImplementationUses + ';');

end;

end;

hasUses := true;

end

else

begin

if not hasUses then

begin

AddText(S,'uses ' + GetImplementationUses + ';' + LineEnding + LineEnding);

hasUses := true;

end;

if TObject(Items[i]) is IFuncProcInfo then

continue

else

if TObject(Items[i]) is TStrings then {note includes helper functions}

S.AddStrings(TStrings(Items[i]))

end;

end;

if not hasUses then

AddText(S,'uses ' + GetImplementationUses + ';' + LineEnding + LineEnding);

S.Add('{$IFNDEF ' + StaticLinkModel + '}');

AddDynamicLegacyCalls(S,0,lcRemovedNoCompatibility);

S.Add('{$ENDIF}');

{Add any other const, var and type declarations}

with ImplementationSection do

for i := firstFuncProc to count - 1 do

begin

if (TObject(Items[i]) is TConstClause) or (TObject(Items[i]) is TVarClause) or

(TObject(Items[i]) is TTypeClause) then

S.AddStrings(TStrings(Items[i]))

else

if TObject(Items[i]) is THelperFunctions then

S.AddStrings(THelperFunctions(Items[i]))

end;

if LegacySupportFunctions.Count > 0 then

begin

S.Add('{$IFDEF ' + StaticLinkModel + '}');

S.Add('');

S.Add('{Legacy Support Functions}');

S.Add('');

S.Add('{$IFNDEF ' + NoLegacySupportSymbol + '}');

with ImplementationSection do

for i := 0 to Count - 1 do

begin

if TObject(Items[i]) is TDirective then

with TObject(Items[i]) as TDirective do

S.Add('{$' + Name + ' ' + Condition + '}')

else

if (TObject(Items[i]) is IFuncProcInfo) and (LegacySupportFunctions.IndexOfObject(TObject(Items[i])) <> -1) then

with TObject(Items[i]) as IFuncProcInfo do

begin

if isFunction then

S.Add('function ' + ProcName + ProcHeader + ': ' + ResultType + ';')

else

S.Add('procedure ' + ProcName + ProcHeader + ';');

S.AddStrings(FunctionBody);

S.Add('');

end;

end;

S.Add('{$ENDIF} { End of ' + NoLegacySupportSymbol + '}');

S.Add('{$ELSE}');

end

else

S.Add('{$IFNDEF ' + StaticLinkModel + '}');

{Everything else is only for dynamic loading}

AddDynamicImplementationSection(S,firstFuncProc);

{Add a type definition for all required error functions}

AddErrorFunctions(S);

AddLoadFunctions(S);

AddUnLoadFunctions(S);

S.Add('{$ENDIF}');

end;

function TGenerateAPIUnit.GetImplementationUses : string;

Result := '';

end;

function TGenerateAPIUnit.GetUnitName(aUnitName : string) : string;

if FGetUnitNamesPass then

Result := inherited

else

if FCopyingFiles then

Result := CopyFilePrefix + aUnitName

else

Result := UnitPrefix + aUnitName;

end;

procedure TGenerateAPIUnit.DoGenerateUnit(sourceFileName ,

destfileName : string);

var S: TStringList;

WriteLine(Format(RSOGeneratingUnit,[destfileName]));

S := TStringList.Create;

try

AddText(S,Format(sUnitIntro,[ExtractFileName(sourceFileName),

ExtractFileName(sourceFileName)]));

AddIncludeList(S);

S.AddStrings(UnitHeader);

AnalyseExternalFunctions;

if GenerateInterfaceSection(S) then

begin

S.Add('');

GenerateImplementationSection(S);

S.Add('');

S.Add('initialization');

S.Add('');

S.AddStrings(InitializationSection);

AddDynamicLoadInit(S);

if FinalizationSection.Count > 0 then

S.Add('');

S.Add('finalization');

S.Add('');

S.AddStrings(FinalizationSection);

end

else

S.Add('implementation');

S.Add('');

S.Add('end.');

finally

S.SaveToFile(destfileName

{$IFNDEF FPC},TEncoding.UTF8{$ENDIF});

S.Free;

end;

end;

procedure TGenerateAPIUnit.PeekSaveLine(var aLine : string);

if FOutFile <> nil then

begin

if aLine = '' then

FOutFile.Add('')

else

AddText(FOutFile,aLine);

end;

end;

procedure TGenerateAPIUnit.SetExternalLibName(aLibName : string);

FLibName := Trim(aLibName);

end;

constructor TGenerateAPIUnit.Create;

inherited Create;

FRemovedFunctions := TStringList.Create;

FCompatibilityFunctions := TStringList.Create;

FLegacySupportFunctions := TStringList.Create;

FLibNamePrefix := DefaultLibNamePrefix;

FUnitNames := TStringList.Create;

FCopyUnitNames := TStringList.Create;

FIncludeFiles := TStringList.Create;

end;

destructor TGenerateAPIUnit.Destroy;

if FRemovedFunctions <> nil then

FreeAndNil(FRemovedFunctions);

if FCompatibilityFunctions <> nil then

FreeAndNil(FCompatibilityFunctions);

if FLegacySupportFunctions <> nil then

FreeAndNil(FLegacySupportFunctions);

if FUnitNames <> nil then

FUnitNames.Free;

if FCopyUnitNames <> nil then

FCopyUnitNames.Free;

if FIncludeFiles <> nil then

FIncludeFiles.Free;

FRemovedFunctions := nil;

inherited Destroy;

end;

procedure TGenerateAPIUnit.Clear;

inherited;

FLibName := '';

if FRemovedFunctions <> nil then

FRemovedFunctions.Clear;

if FCompatibilityFunctions <> nil then

FCompatibilityFunctions.Clear;

if FLegacySupportFunctions <> nil then

FLegacySupportFunctions.Clear;

end;

procedure TGenerateAPIUnit.GenerateHeaderUnitFrom(sourceFilename ,

destDir : string; aLibName : string);

FLibName := aLibName;

ReadAPIHeaderFile(sourceFilename);

if FLibName = '' then

FLibName := GetLibNameForUnit;

DoGenerateUnit(sourceFilename,destDir + DirectorySeparator + UnitName + '.pas');

FLibName := '';

end;

procedure TGenerateAPIUnit.GenerateHeaderUnitFromDir(sourceDir ,

destDir : string; copyFiles : TStrings; aLibName : string);

var token: TSearchRec;

AllHeaders: TStrings;

lastUnitName: string;

GetUnitNamesList(sourceDir,HeaderSrcFilter);

DoCopyFiles(copyFiles,destDir);

lastUnitName := '';

AllHeaders := TStringList.Create;

try

AllHeaders.Add('unit ' + UnitPrefix + AllHeadersUnitName + ';');

AllHeaders.Add('');

AllHeaders.Add('interface');

AllHeaders.Add('');

AllHeaders.Add('uses');

if FindFirst(SourceDir + DirectorySeparator + HeaderSrcFilter,0,token) = 0 then

try

repeat

if lastUnitName <> '' then

AllHeaders.Add(' ' + lastUnitName + ',');

GenerateHeaderUnitFrom(SourceDir + DirectorySeparator + token.Name,destDir,aLibName);

lastUnitName := UnitName;

until FindNext(token) <> 0;

finally

FindClose(token);

end;

if lastUnitName <> '' then

AllHeaders.Add(' ' + lastUnitName + ';');

AllHeaders.Add('');

AllHeaders.Add('implementation');

AllHeaders.Add('');

AllHeaders.Add('end.');

AllHeaders.SaveToFile(destDir + DirectorySeparator + UnitPrefix + AllHeadersUnitName + '.pas'

{$IFNDEF FPC},TEncoding.UTF8{$ENDIF});

finally

FCopyUnitNames.Clear;

FUnitNames.Clear;

FIncludeFiles.Clear;

Allheaders.Free;

end;

end;

end.