[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
{$A+,B-,F-,G+,I-,P-,Q-,R-,S-,T-,V-,X+,Y+}
Program H2Pas;
{ Program: H2PAS
Version: 1.21
Purpose: convert C header files to some kind of Pascal units
Developer: Peter Sawatzki (ps) (c) 1993
Buchenhof 3, 58091 Hagen, Germany
CompuServe: 100031,3002
revision history:
date version author modification
11/03/93 1.00 ps written
05/10/94 1.10 ps add EXEHDR import support
06/29/94 1.2x ps minor modifications
}
Uses
Objects,
Strings;
Const
Version = 'H2Pas v.1.21';
H2PasIni= 'H2Pas.Ini';
CRLF = #13#10;
StdUses: pChar = 'Uses'+CRLF+
' WinTypes,'+CRLF+
' WinProcs;';
HasImports: Boolean = False;
WhichBlock: (Undefd, InConst, InType, InVar, InFunc) = Undefd;
Var
DstName,
Imports: String[67];
Function WordCount(aStr, Delims: pChar): Integer;
Var
Count: Integer;
EndStr: pChar;
Begin
EndStr:= StrEnd(aStr);
Count:= 0;
While aStr<=EndStr Do Begin
While (aStr<=EndStr) And (StrScan(Delims, aStr[0])<>Nil) Do Inc(aStr);
If aStr<=EndStr Then Inc(Count);
While (aStr<=EndStr) And (StrScan(Delims, aStr[0])=Nil) Do Inc(aStr)
End;
WordCount:= Count
End;
Function WordPosition (aStr, Delims: pChar; No: Integer): pChar;
Var
Count: Integer;
EndStr: pChar;
Begin
EndStr:= StrEnd(aStr);
Count:= 0;
WordPosition:= Nil;
While (aStr<=EndStr) And (Count<>No) Do Begin
While (aStr<=EndStr) And (StrScan(Delims, aStr[0])<>Nil) Do Inc(aStr);
If aStr<=EndStr Then Inc(Count);
If Count<>No Then
While (aStr<=EndStr) And (StrScan(Delims, aStr[0])=Nil) Do Inc(aStr)
Else
WordPosition:= aStr
End
End;
Function ExtractWord (aDst, aStr, Delims: pChar; No: Integer): pChar;
Var
EndStr: pChar;
Begin
ExtractWord:= aDst;
aStr:= WordPosition(aStr, Delims, No);
If Assigned(aStr) Then Begin
EndStr:= StrEnd(aStr);
While (aStr<=EndStr) And (StrScan(Delims, aStr[0])=Nil) Do Begin
aDst[0]:= aStr[0];
Inc(aStr);
Inc(aDst)
End
End;
aDst[0]:= #0
End;
Function Trim (aDst, aSrc: pChar): pChar;
Var
EndStr: pChar;
Begin
Trim:= aDst;
If Not Assigned(aSrc) Or (aSrc[0]=#0) Then
aDst[0]:= #0
Else Begin
EndStr:= StrEnd(aSrc);
While (aSrc<EndStr) And (aSrc[0]<=' ') Do
Inc(aSrc);
StrCopy(aDst, aSrc);
EndStr:= StrEnd(aDst);
While (EndStr>aDst) And (EndStr[0]<=' ') Do Begin
EndStr[0]:= #0;
Dec(EndStr)
End
End
End;
Function Pad (aDst, aSrc: pChar; Count: Integer): pChar;
Begin
Pad:= aDst;
If aDst<>aSrc Then
StrCopy(aDst, aSrc);
Count:= Count-StrLen(aDst);
aDst:= StrEnd(aDst);
While Count>0 Do Begin
aDst[0]:= ' ';
Inc(aDst);
Dec(Count)
End;
aDst[0]:= #0
End;
Function StrIPos(Str1, Str2: PChar): PChar;
Var
EndStr: pChar;
Len: Integer;
Begin
StrIPos:= Nil;
EndStr:= StrEnd(Str1);
Len:= StrLen(Str2);
Repeat
Str1:= StrScan(Str1, Str2[0]);
If Str1=Nil Then Exit;
If StrLIComp(Str1, Str2, Len)=0 Then Begin
StrIPos:= Str1;
Exit
End;
Inc(Str1)
Until Str1>EndStr
End;
Function JustFilename(PathName : string) : string;
{-Return just the filename of a pathname}
Var
I: Word;
Begin
I:= Succ(Word(Length(PathName)));
Repeat
Dec(I);
Until (PathName[I] in ['\', ':', #0]) or (I = 0);
JustFilename := Copy(PathName, Succ(I), 64);
End;
function JustName(PathName : string) : string;
{-Return just the name (no extension, no path) of a pathname}
var
DotPos : Byte;
begin
PathName := JustFileName(PathName);
DotPos := Pos('.', PathName);
if DotPos > 0 then
PathName := Copy(PathName, 1, DotPos-1);
JustName := PathName;
end;
Function JustPath(aName: string): string;
{-Return just the path of a filename}
Var
I: Word;
Begin
I:= Succ(Word(Length(aName)));
Repeat
Dec(I);
Until (aName[I] in ['\', ':', #0]) or (I = 0);
JustPath:= Copy(aName, 1, I)
End;
Procedure Fatal (aMsg: pChar);
Begin
WriteLn(aMsg);
Halt(255)
End;
Function GetLine (aDst: pChar; Var aFile: Text): pChar;
Var
aString: String;
p,i: Integer;
Begin
{$i-}
ReadLn(aFile, aString);
If IoResult<>0 Then Fatal('Read error.');
p:= Pos('//', aString);
If p>0 Then Begin
aString[p+1]:= '*';
aString:= aString+' */'
End;
p:= Pos(#9, aString);
While p>0 Do Begin
aString[p]:= ' ';
For i:= 1 To 7-((p-1) Mod 8) Do
Insert(' ', aString, p);
p:= Pos(#9, aString)
End;
GetLine:= StrPCopy(aDst, aString)
End;
Procedure OutLn (Var aFile: Text; OutStr: pChar);
Var
oc: Char;
Begin
While OutStr[0]<>#0 Do Begin
oc:= OutStr[0];
Case oc Of
'/': If OutStr[1]='*' Then Begin
oc:= '{';
Inc(OutStr,1)
End;
'*': If OutStr[1]='/' Then Begin
oc:= '}';
Inc(OutStr)
End
End;
Write(aFile, oc);
If IoResult<>0 Then Fatal('Write error.');
Inc(OutStr)
End;
Write(aFile,CRLF);
If IoResult<>0 Then Fatal('Write error.')
End;
Procedure HeaderInfo (Var aFile: Text);
Var
aLine: Array[0..100] Of Char;
Begin
WriteLn(aFile, '{ Unit: ',DstName);
WriteLn(aFile, ' Version: 1.00');
WriteLn(aFile, ' translated from file ',DstName,'.H');
WriteLn(aFile, ' raw translation using '+Version+', (c) Peter Sawatzki');
WriteLn(aFile, ' fine tuned by:');
WriteLn(aFile, ' (fill in)');
WriteLn(aFile, ' ');
WriteLn(aFile, ' revision history:');
WriteLn(aFile, ' Date: Ver: Author: Mod:');
WriteLn(aFile, ' xx/xx/94 1.00 <name> <modification>');
WriteLn(aFile, '}');
WriteLn(aFile, 'Unit ',DstName,';');
WriteLn(aFile, 'Interface');
If StrLen(StdUses)<>0 Then
WriteLn(aFile, StdUses);
End;
{-the collection part}
Type
pImportEntry = ^tImportEntry;
tImportEntry = Record
TheName,
TheDLL,
TheOrd: pChar
End;
pImportCollection = ^tImportCollection;
tImportCollection = Object(tSortedCollection)
Function KeyOf(Item: Pointer): Pointer; Virtual;
Function Compare(Key1, Key2: Pointer): Integer; Virtual;
Procedure FreeItem(Item: Pointer); Virtual;
End;
pTypeMap = ^tTypeMap;
tTypeMap = Record
F, T: pChar;
End;
pTypeMapCollection = ^tTypeMapCollection;
tTypeMapCollection = Object(tSortedCollection)
Function KeyOf(Item: Pointer): Pointer; Virtual;
Function Compare(Key1, Key2: Pointer): Integer; Virtual;
Procedure FreeItem(Item: Pointer); Virtual;
End;
Function tImportCollection.KeyOf(Item: Pointer): Pointer;
Begin
KeyOf:= pImportEntry(Item)^.TheName
End;
Function tImportCollection.Compare(Key1, Key2: Pointer): Integer;
Begin
Compare:= StrIComp(Key1, Key2)
End;
Procedure TImportCollection.FreeItem(Item: Pointer);
Begin
StrDispose(pImportEntry(Item)^.TheName);
StrDispose(pImportEntry(Item)^.TheDLL);
StrDispose(pImportEntry(Item)^.TheOrd);
Dispose(pImportEntry(Item))
End;
Function tTypeMapCollection.KeyOf(Item: Pointer): Pointer;
Begin
KeyOf:= pTypeMap(Item)^.F
End;
Function tTypeMapCollection.Compare(Key1, Key2: Pointer): Integer;
Begin
Compare:= StrIComp(Key1, Key2)
End;
Procedure tTypeMapCollection.FreeItem(Item: Pointer);
Begin
StrDispose(pTypeMap(Item)^.F);
StrDispose(pTypeMap(Item)^.T);
Dispose(pTypeMap(Item))
End;
Const
TheImports: pImportCollection = Nil;
TheFuncs: pStrCollection = Nil;
TheStructs: pStrCollection = Nil;
TheTypeMap: pTypeMapCollection = Nil;
TheModMap: pStrCollection = Nil;
Procedure CreateCollections;
Begin
TheImports:= New(pImportCollection, Init(100, 50));
TheFuncs:= New(pStrCollection, Init(10, 20));
TheStructs:= New(pStrCollection, Init(10, 20));
TheTypeMap:= New(pTypeMapCollection, Init(10, 10));
TheModMap:= New(pStrCollection, Init(10, 10));
End;
Procedure DestroyCollections;
Begin
If Assigned(TheImports) Then Dispose(TheImports, Done);
If Assigned(TheFuncs) Then Dispose(TheFuncs, Done);
If Assigned(TheStructs) Then Dispose(TheStructs, Done);
If Assigned(TheTypeMap) Then Dispose(TheTypeMap, Done);
If Assigned(TheModMap) Then Dispose(TheModMap, Done);
End;
Procedure AddImport (aName, aDLL, anOrd: pChar);
Var
anEntry: pImportEntry;
Begin
anEntry:= New(pImportEntry);
anEntry^.TheName:= StrNew(aName);
anEntry^.TheDLL:= StrNew(aDLL);
anEntry^.TheOrd:= StrNew(anOrd);
TheImports^.Insert(anEntry)
End;
Procedure AddFunc (aName: pChar);
Begin
TheFuncs^.Insert(StrNew(aName))
End;
Procedure AddStruct (aName: pChar);
Begin
TheStructs^.Insert(StrNew(aName))
End;
Procedure AddType (aSrc, aDst: pChar);
Var
anEntry: pTypeMap;
Begin
anEntry:= New(pTypeMap);
anEntry^.F:= StrNew(aSrc);
anEntry^.T:= StrNew(aDst);
TheTypeMap^.Insert(anEntry)
End;
Procedure AddMod (aName: pChar);
Begin
TheModMap^.Insert(StrNew(aName))
End;
Function GetOrdDLL (aName, RetDLL, RetOrd: pChar): Boolean;
Var
Index: Integer;
Begin
If TheImports^.Search(aName, Index) Then
With pImportEntry(TheImports^.At(Index))^ Do Begin
GetOrdDLL:= True;
StrCopy(RetDLL, TheDLL);
StrCopy(RetOrd, TheOrd)
End
Else
GetOrdDLL:= False
End;
Procedure ReadImports (aFileName: String);
Var
aFile: Text;
aLine: Array[0..500] Of Char;
aName,
aDLL,
anOrd: Array[0..60] Of Char;
aWord: Array[0..60] Of Char;
Begin
{$i-} Assign(aFile, aFileName); Reset(aFile);
If IoResult<>0 Then Exit;
HasImports:= True;
StrCopy(aDLL, '?');
While Not Eof(aFile) Do Begin
GetLine(aLine, aFile);
If StrComp(ExtractWord(aWord, aLine, ' ', 1),'Library:')=0 Then
ExtractWord(aDLL, aLine, ' ', 2)
Else
If StrComp(ExtractWord(aWord, aLine, ' ', 5),'exported,')=0 Then Begin
ExtractWord(anOrd, aLine, ' ', 1);
ExtractWord(aName, aLine, ' ', 4);
AddImport(aName, aDLL, anOrd)
End
End;
Close(aFile)
End;
Procedure ReadIni;
Var
IniFile: Text;
aStr: String;
aLine, Word1, Word2: Array[0..255] Of Char;
rm: (rmNone, rmTypeMap, rmModMap);
p: Integer;
Begin
{$i-}
Assign(IniFile, H2PasIni); Reset(IniFile);
If IoResult<>0 Then Begin
Assign(IniFile, JustPath(ParamStr(0))+'\'+H2PasIni);
Reset(IniFile);
If IoResult<>0 Then
Exit
End;
rm:= rmNone;
While Not Eof(IniFile) Do Begin
ReadLn(IniFile, aStr);
p:= Pos(';', aStr); If (p>0) Then aStr[0]:= Chr(p-1);
StrPCopy(aLine, aStr); Trim(aLine, aLine);
If StrLen(aLine)=0 Then
Continue;
If aLine[0]='[' Then Begin
If StrIComp(aLine, '[TypeMap]')=0 Then rm:= rmTypeMap Else
If StrIComp(aLine, '[ModMap]')=0 Then rm:= rmModMap Else
rm:= rmNone;
Continue
End;
Case rm Of
rmTypeMap: AddType(Trim(Word1, ExtractWord(Word1, aLine, '=', 1)),
Trim(Word2, ExtractWord(Word2, aLine, '=', 2)));
rmModMap: AddMod(aLine);
End
End;
Close(IniFile)
End;
Function Modifier (aPart: pChar): Boolean;
Var
Index: Integer;
Begin
Modifier:= TheModMap^.Search(aPart, Index)
End;
Function TypeConvert (aDst, aSrc: pChar): pChar;
Var
aWord, ToParse: Array[0..79] Of Char;
i, anInt, anError: Integer;
aTemp: Array[0..79] Of Char;
Index: Integer;
Begin
TypeConvert:= aDst;
aDst[0]:= #0;
ExtractWord(aTemp, aSrc, '[]', 2);
If StrLen(aTemp)>0 Then Begin
Val(aTemp, anInt, anError);
If anError=0 Then Begin
Str(anInt-1:0, aTemp);
StrCat(StrCat(StrCat(aDst,'Array[0..'), aTemp),'] Of ');
End Else
StrCat(StrCat(StrCat(aDst,'?'), aTemp),'?')
End;
ExtractWord(ToParse, aSrc, '[]', 1);
aTemp[0]:= #0;
For i:= 1 To WordCount(ToParse, ' ') Do Begin
ExtractWord(aWord, ToParse, ' ', i);
If aWord[0]='*' Then Begin
StrCat(aTemp,'* ');
aWord[0]:= ' ';
Trim(aWord, aWord)
End;
If (aWord[0]<>#0) And Not Modifier(aWord) Then
StrCat(StrCat(aTemp, aWord),' ');
End;
Trim(aTemp, aTemp);
If TheTypeMap^.Search(@aTemp, Index) Then
With pTypeMap(TheTypeMap^.At(Index))^ Do
StrCopy(aTemp, T);
StrCat(aDst, aTemp)
End;
Const
IdMax = 50;
Type
tIdTable = Array[1..IdMax] Of
Record
TheId,
TheType: Array[0..79] Of Char;
TheComment: Array[0..300] Of Char
End;
Var
IdCnt: Integer;
IdTable: tIdTable;
Procedure InitId;
Begin
IdCnt:= 0
End;
Procedure AddId (anId, aType, aComment: pChar);
Begin
If IdCnt=IdMax Then Begin
WriteLn('Error: Id Table full. HALT.');
Halt(1)
End;
Inc(IdCnt);
With IdTable[IdCnt] Do Begin
Trim(TheId, anId);
TypeConvert(TheType, aType);
Trim(TheComment, aComment)
End
End;
Function ParseComment(Var Inf: Text; InStr, OutStr: pChar): Boolean;
Var
aWord: Array[0..40] Of Char;
Begin
ParseComment:= False;
If StrPos(StrLCopy(aWord, InStr, 5),'/*')=Nil Then Exit;
While StrPos(InStr, '*/')=Nil Do Begin
StrCat(OutStr, InStr);
GetLine(InStr, Inf)
End;
StrCat(OutStr, InStr);
ParseComment:= True
End;
Function ParseDefine(InStr, OutStr: pChar): Boolean;
Const
DefineDelim = ' ';
Var
aWord: Array[0..512] Of Char;
Rest, p: pChar;
isConst: Boolean;
i: Integer;
Begin
ParseDefine:= False;
If WordCount(InStr, DefineDelim)<3 Then Exit;
If (ExtractWord(aWord, InStr, DefineDelim, 1)<>Nil)
And (StrIComp(aWord, '#define')=0) Then Begin
isConst:= False;
If WhichBlock<>InConst Then
StrCopy(OutStr,CRLF+'Const'+CRLF+' ')
Else
StrCopy(OutStr,' ');
ExtractWord(StrEnd(OutStr), InStr, DefineDelim, 2);
StrCat(Pad(OutStr, OutStr, 35), '= ');
Rest:= WordPosition(InStr, DefineDelim, 3);
StrCopy(aWord, Rest);
p:= StrPos(aWord,'/*'); If Assigned(p) Then p^:= #0;
Trim(aWord, aWord);
If StrLen(aWord)>15 Then Exit;
p:= StrPos(aWord, '0x');
While Assigned(p) Do Begin
isConst:= True;
p[0]:= ' ';
p[1]:= '$';
p:= StrPos(p, '0x')
End;
p:= StrScan(aWord, 'L'); {get rid of the f*cking 'L'}
While Assigned(p) Do Begin
If (p>aWord) Then Begin
Dec(p);
If p^ In ['0'..'9','A'..'F','a'..'f'] Then Begin
p[1]:= ' ';
IsConst:= True
End;
Inc(p)
End;
p:= StrScan(p+1, 'L')
End;
If Not IsConst Then
For i:= 0 To StrLen(aWord)-1 Do
If aWord[i] In ['0'..'9'] Then Begin
IsConst:= True;
Break
End;
If Not IsConst Then
Exit;
Trim(aWord, aWord);
StrCat(StrCat(OutStr, aWord), ';');
p:= StrPos(Rest,'/*');
If Assigned(p) Then
StrCat(Pad(OutStr,OutStr, 60), p);
WhichBlock:= InConst;
ParseDefine:= True
End
End;
Function ParseStruct(Var Inf: Text; InStr, OutStr: pChar): Boolean;
Var
aWord,
aComment,
RecComment,
RecName,
anId, aType,
Rest: Array[0..300] Of Char;
possibleArray: Array[0..60] Of Char;
p, cp: pChar;
i: Integer;
Begin
ParseStruct:= False;
If (StrIComp(ExtractWord(aWord, Instr, ' ', 1), 'struct')<>0)
And (StrIComp(ExtractWord(aWord, Instr, ' ', 2), 'struct')<>0) Then
Exit;
p:= Instr;
Instr:= StrScan(InStr, '{');
If Not Assigned(InStr) Then Exit;
{-try to parse the structure}
InStr^:= #0;
ExtractWord(RecName, p, ' ', WordCount(p,' '));
Inc(InStr);
Trim(InStr, InStr);
If (InStr[0]='/') And (InStr[1]='*') Then
StrCopy(RecComment, InStr)
Else
RecComment[0]:= #0;
InStr:= StrEnd(InStr);
cp:= InStr;
Repeat
GetLine(cp, Inf);
p:= StrScan(cp, '}');
cp:= StrEnd(cp);
cp^:= ' '; Inc(cp); cp^:= #0
Until Assigned(p);
If WordCount(p+1,' ;')>0 Then
ExtractWord(RecName, p+1, ' ;', 1);
pChar(p-1)^:= #0;
InitId;
p:= InStr;
Repeat
cp:= p;
p:= StrScan(p, ';');
If Assigned(p) Then Begin
Trim(aWord, ExtractWord(aWord, cp, ';', 1));
{extract possible comment}
cp:= StrPos(aWord, '/*');
If Assigned(cp) Then Begin
StrCopy(aComment, cp);
cp^:= #0
End Else
aComment[0]:= #0;
{-extract id and type}
cp:= WordPosition(aWord, ' *', WordCount(aWord, ' *')); {last word}
StrCopy(anId, cp);
ExtractWord(possibleArray, anId,'[]',2);
ExtractWord(anId, anId, '[]', 1);
cp^:= #0;
StrCopy(aType, aWord);
If StrLen(possibleArray)>0 Then
StrCat(StrCat(StrCat(aType,'['),possibleArray),']');
{-extract comment if after ';'}
Inc(p);
While p^=' ' Do Inc(p);
While (p[0]='/') And (p[1]='*') Do Begin
{append comment}
cp:= StrEnd(aComment);
Repeat
cp^:= p^;
Inc(p);
Inc(cp)
Until (p[0]=#0) Or ((p[0]='*') And (p[1]='/'));
cp[0]:= #0; StrCat(Trim(aComment, aComment),' */');
If p[0]<>#0 Then
Inc(p,2);
While p^=' ' Do Inc(p)
End;
AddId(anId, aType, aComment)
End
Until Not Assigned(p);
{-output the structure}
If WhichBlock<>InType Then Begin
StrCopy(OutStr,CRLF+'Type'+CRLF);
OutStr:= StrEnd(OutStr)
End;
StrCopy(OutStr,' ');
StrCat(OutStr, RecName);
StrCat(OutStr,' = Record');
If RecComment[0]<>#0 Then
StrCat(Pad(OutStr, OutStr, 40), RecComment);
StrCat(OutStr,CRLF);
For i:= 1 To IdCnt Do Begin
OutStr:= StrEnd(OutStr);
With IdTable[i] Do Begin
StrCopy(OutStr,' ');
{If StrIComp(TheId, TheType)=0 Then StrCat(OutStr, '_');} {it works as is}
StrCat(OutStr, TheId);
If (i<IdCnt) And (StrIComp(IdTable[i].TheType, IdTable[i+1].TheType)=0) Then
StrCat(OutStr,', ')
Else Begin
StrCat(StrCat(OutStr,': '),TheType);
If i<IdCnt Then
StrCat(OutStr,'; ')
End;
If TheComment[0]<>#0 Then Begin
Pad(OutStr, OutStr, 40);
StrCat(OutStr, TheComment)
End;
StrCat(OutStr,CRLF)
End
End;
StrCat(OutStr,' End;');
AddStruct(RecName);
WhichBlock:= InType;
ParseStruct:= True
End;
Function ParseAPI(Var Inf: Text; InStr, OutStr: pChar): Boolean;
Var
FHead,
aWord,
Res,
FuncComment,
FuncName,
anId, aType, aComment: Array[0..200] Of Char;
p, cp, cp2, pStart: pChar;
i, Indent: Integer;
IsFunc: Boolean;
Unknown: Integer;
Function ParseWordAndComment (aComment, aWord, Src: pChar; Delim: Char): pChar;
{parse Src, search for delim. append comments to aComment, source to aWord}
Var
cp: pChar;
Begin
Repeat
While Src^=' ' Do Inc(Src);
While (Src[0]='/') And (Src[1]='*') Do Begin
{append comment}
cp:= StrEnd(aComment);
Repeat
cp^:= Src^;
Inc(Src);
Inc(cp)
Until (Src[0]=#0) Or ((Src[0]='*') And (Src[1]='/'));
cp[0]:= #0; StrCat(Trim(aComment, aComment),' */');
If Src[0]<>#0 Then
Inc(Src,2);
While Src^=' ' Do Inc(Src)
End;
cp:= StrEnd(aWord);
While Not(Src^ In [#0,',','/']) Do Begin
cp^:= Src^; Inc(Src); Inc(cp)
End;
cp^:= #0;
If Src^=#0 Then Begin
ParseWordAndComment:= Src;
Exit
End
Until Src^=',';
Inc(Src);
While Src^=' ' Do Inc(Src);
While (Src[0]='/') And (Src[1]='*') Do Begin
{append comment}
cp:= StrEnd(aComment);
Repeat
cp^:= Src^;
Inc(Src);
Inc(cp)
Until (Src[0]=#0) Or ((Src[0]='*') And (Src[1]='/'));
cp[0]:= #0; StrCat(Trim(aComment, aComment),' */');
If Src[0]<>#0 Then
Inc(Src,2);
While Src^=' ' Do Inc(Src)
End;
ParseWordAndComment:= Src
End;
Begin
ParseAPI:= False;
IsFunc:= False;
FuncName[0]:= #0;
Res[0]:= #0;
If (StrPos(InStr,'typedef')<>Nil)
Or (StrPos(InStr,'#define')<>Nil)
Or (StrPos(InStr,'#if')<>Nil)
Or (StrPos(InStr,'#el')<>Nil) Then Exit;
pStart:= StrScan(InStr, '(');
If Not Assigned(pStart) Then Exit;
pStart^:= #0;
Trim(FuncName, ExtractWord(FuncName, InStr, ' ', WordCount(InStr, ' ')));
cp:= WordPosition(InStr, ' ', WordCount(InStr, ' '));
If Assigned(cp) Then Begin
cp[0]:= #0;
Trim(Res, TypeConvert(Res, InStr))
End Else
StrCopy(Res, '?????');
InStr:= pStart+1;
cp:= InStr;
p:= StrScan(cp, ';');
While Not Assigned(p) Do Begin
cp:= StrEnd(cp);
cp^:= ' '; Inc(cp);
GetLine(cp, Inf);
p:= StrScan(cp, ';')
End;
StrCopy(FuncComment, p+1);
Repeat
Dec(p)
Until (p<=InStr) Or (p^=')');
p^:= #0;
InitId;
Unknown:= 0;
p:= InStr;
While p^<>#0 Do Begin
aComment[0]:= #0;
aWord[0]:= #0;
p:= ParseWordAndComment(aComment, aWord, p, ',');
Trim(aWord, aWord);
TypeConvert(aType, aWord);
anId[0]:= #0;
cp:= WordPosition(aWord, ' *', WordCount(aWord, ' *')); {last word}
If (WordCount(aWord,' *')=1)
Or (Assigned(cp) And (StrIComp(cp, TypeConvert(aType, cp))<>0)) Then Begin
{non-Ansi declaration}
Inc(Unknown);
Str(Unknown, anId);
Move(anId[0], anId[3], StrLen(anId)+1);
anId[0]:= 'P'; anId[1]:= 'a'; anId[2]:= 'r';
End Else Begin
If Assigned(cp) Then Begin
StrCopy(anId, cp);
cp^:= #0
End;
TypeConvert(aType, aWord)
End;
AddId(anId, aType, aComment)
End;
StrCopy(OutStr, ' Function ');
StrCat(OutStr, FuncName);
StrCat(OutStr, ' (');
Indent:= StrLen(OutStr);
OutStr:= StrEnd(OutStr);
aWord[0]:= #0;
For i:= 1 To IdCnt Do
With IdTable[i] Do Begin
StrCat(aWord, TheId);
If (i<IdCnt) And (StrIComp(IdTable[i].TheType, IdTable[i+1].TheType)=0) Then
StrCat(aWord, ', ')
Else Begin
StrCat(StrCat(aWord, ': '), TheType);
If i<IdCnt Then StrCat(aWord, '; ')
End;
Trim(aWord, aWord);
If TheComment[0]<>#0 Then
StrCat(Pad(aWord, aWord, 60-Indent), TheComment);
If (Indent+StrLen(aWord)>90) Or (TheComment[0]<>#0) Then Begin
StrCopy(OutStr, aWord); OutStr:= StrEnd(OutStr);
If i<IdCnt Then Begin
StrCat(OutStr, CRLF);
Pad(OutStr, OutStr, 2+Indent)
End;
OutStr:= StrEnd(OutStr);
aWord[0]:= #0
End
End;
StrCat(StrCat(StrCat(StrCat(StrCat(OutStr, aWord),'): '), Res),';'), FuncComment);
AddFunc(FuncName);
WhichBlock:= InFunc;
ParseAPI:= True
End;
Procedure GenerateReport (Var Out: Text);
Procedure RepFunc (Item: Pointer); Far;
Var
aDLL, anOrd: Array[0..60] Of Char;
aLine: Array[0..200] Of Char;
Begin
StrCopy(aDLL,'?');
StrCopy(anOrd, '?');
If HasImports Then
GetOrdDLL(Item, aDLL, anOrd);
StrCat(StrCat(StrCopy(aLine,' Function '), pChar(Item)),';');
StrCat(Pad(aLine, aLine, 42),'External ''');
StrCat(StrCat(aLine, aDLL), '''');
StrCat(Pad(aLine, aLine, 62),'Index ');
StrCat(StrCat(Pad(aLine, aLine, 72-StrLen(anOrd)), anOrd),';');
WriteLn(Out,aLine)
End;
Procedure VeriPascal (Item: Pointer); Far;
Var
aLine: Array[0..200] Of Char;
aName: Array[0..60] Of Char;
Begin
Pad(aName, Item, 35);
StrCat(StrCopy(aLine,' veri('''), aName);
StrCat(StrCat(StrCat(aLine,''',sizeof('),aName),'));');
WriteLn(Out,aLine)
End;
Procedure VeriC (Item: Pointer); Far;
Var
aLine: Array[0..200] Of Char;
aName: Array[0..60] Of Char;
Begin
Pad(aName, Item, 35);
StrCat(StrCopy(aLine,' veri("'), aName);
StrCat(StrCat(StrCat(aLine,'",sizeof('),aName),'));');
WriteLn(Out,aLine)
End;
Begin
WriteLn(Out, 'Implementation');
TheFuncs^.ForEach(@RepFunc);
WriteLn(Out, 'End.');
WriteLn(Out);
WriteLn(Out, '--- snip --- snip --- snip ---');
WriteLn(Out,CRLF+CRLF+'{Pascal verification program for '+Dstname+' }');
WriteLn(Out,'Program VeriP;'+CRLF+
'Uses'+CRLF+
' '+DstName+';'+CRLF);
WriteLn(Out,'Procedure Veri (aStr: pChar; aSize: Integer);');
WriteLn(Out,'Begin');
WriteLn(Out,' WriteLn(''Size of '',aStr,''= '',aSize:5);');
WriteLn(Out,'End;'+CRLF);
WriteLn(Out,'Begin');
WriteLn(Out,' WriteLn(''verification of '+DstName+' for Pascal:'');');
TheStructs^.ForEach(@VeriPascal);
WriteLn(Out,'End.');
WriteLn(Out);
WriteLn(Out,CRLF+CRLF+'/* C verification program for '+DstName+' */');
WriteLn(Out,'#include <stdio.h>'+CRLF+
'#include "'+DstName+'.h"'+CRLF+
'void veri (char *aStr, int aSize)'+CRLF+
'{ printf("Size of %s= %5i\n",aStr,aSize); }'+CRLF);
WriteLn(Out,'void main (void)'+CRLF+
'{ printf("verification of '+DstName+' for C:\n");');
TheStructs^.ForEach(@VeriC);
WriteLn(Out,'}');
End;
Const
LineBufSize = 5000;
IoBufSize = 32*1024;
Type
IoBuf = Array[0..IoBufSize-1] Of Char;
pIoBuf = ^IoBuf;
Var
Inf, Out: Text;
InStr,
OutStr: pChar;
Begin
WriteLn(Version,', written 1993 by P. Sawatzki');
If Not (ParamCount In [2,3]) Then Begin
WriteLn('Usage: H2Pas InFile OutFile [ImportList]');
Halt
End;
CreateCollections;
ReadIni;
If ParamStr(3)<>'' Then
Imports:= ParamStr(3)
Else
Imports:= JustName(ParamStr(1))+'.Imp';
{$i-}
Assign(Inf, ParamStr(1)); Reset(Inf);
If IoResult<>0 Then Fatal('Input file not found');
Assign(Out, ParamStr(2)); ReWrite(Out);
If IoResult<>0 Then Fatal('Unable to create output file');
DstName:= JustName(ParamStr(2));
GetMem(InStr, LineBufSize);
GetMem(OutStr, LineBufSize);
Write('Processing files...');
HeaderInfo(Out);
While Not Eof(Inf) Do Begin
GetLine(InStr, Inf);
OutStr[0]:= #0;
If ParseComment(Inf, InStr, OutStr)
Or ParseDefine(InStr, OutStr)
Or ParseStruct(Inf, InStr, OutStr)
Or ParseAPI(Inf, InStr, OutStr) Then
OutLn(Out, OutStr)
Else
OutLn(Out, InStr)
End;
WriteLn('Done.');
Write('Reading import file ',Imports,'...');
ReadImports(Imports);
If HasImports Then
WriteLn('Done.')
Else
WriteLn('Not found.'+CRLF+
'(generate an import file using "EXEHDR File.DLL >'+JustName(ParamStr(1))+
'.Imp")');
Write('Appending report...');
GenerateReport(Out);
WriteLn('Done.');
DestroyCollections;
FreeMem(InStr, LineBufSize);
FreeMem(OutStr, LineBufSize);
Close(Inf);
Close(Out)
End.
{ ------------- INFO ON THIS PROGRAM ------------------ }
ReadMe.Txt for H2Pas
====================
H2Pas is a quick and dirty hack to convert C-Header files to Pascal units.
If you make modifications, please drop me a copy at
Peter Sawatzki, CompuServe 100031,3002
In it's current implementation (1.20) H2Pas does the following:
- convert structs
- convert constant defines
- convert procedure/function headers
- 'convert' comments of style /* xxxx */ to { xxxx }
and comments of style // yyyy to { yyy }
- make use of IMPort files to resolve DLL index entries
- output C and Pascal code to verify correctness of C and Pascal
structure sizes
How to use and generate import files:
-------------------------------------
if a EXEHDR type .IMP file is present for the DLL with information
about the entry points of a function, H2Pas outputs an unit implementation
section with entries of the form:
Function Ctl3DEnabled; External 'CTL3D' Index 5;
where the appropriate indices are resolved from information gathered
from the .IMP file.
To generate the .IMP file for a DLL -say CTL3D.DLL- one must do the following:
EXEHDR CTL3D.DLL >CTL3D.IMP
How to execute H2Pas
--------------------
Usage:
H2Pas Ctl3D.H Ctl3D.Pas [Ctl3D.Imp]
where Ctl3D.H is the source C header file,
Ctl3D.Pas is the destination pascal unit to be generated
and Ctl3D.Imp is an optional import file generated from EXEHDR
H2Pas.Ini
---------
currently H2Pas.Ini has two areas for customization:
[TypeMap]
C-Type = Pascal-Type
maps a certain C-type to a Pascal type (see sample H2Pas.Ini)
[ModMap]
modifier
a list of modifiers that H2Pas should ignore (see sample H2Pas.Ini)
written by
Peter Sawatzki
Buchenhof 3
58091 Hagen / Germany
CompuServe: 100031,3002
{ ------------------ SAMPLE INI FILE NEED FOR THIS UNIT ---------- }
{ CUT and Save as H2PAS.INI }
[TypeMap]
unsigned = Word
unsigned int = Word
char = Char
unsigned long = LongInt
int = Integer
char far * = pChar
unsigned char = Byte
byte = Byte
char * = pChar
long = LongInt
WORD = Word
DWORD = LongInt
ULONG = LongInt
BOOL = Bool
UINT = Word
void * = Pointer
; Windows stuff
BITMAPINFO = tBitmapInfo
HANDLE = tHandle
HWINDOW = hWindow
COLORREF = tColorRef
[ModMap]
WINAPI
WINGAPI
APIENTRY
EXPENTRY
EXPORT
EXTERN
PASCAL
FAR
_FAR
const
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]