📄 headpars.~pas
字号:
{******************************************************************}
{ }
{ Dr. Bob's Head Converter Utility Command Line Version }
{ }
{ Copyright (C) 1997-2002 Bob Swart (A.K.A. Dr. Bob). }
{ }
{ Contributor(s): Alan C. Moore (acmdoc@aol.com) }
{ }
{ }
{ Obtained through: }
{ Joint Endeavour of Delphi Innovators (Project JEDI) }
{ }
{ You may retrieve the latest version of this file at the Project }
{ JEDI home page, located at http://delphi-jedi.org }
{ Maintained by the Project JEDI DARTH Team; To join or to report }
{ bugs, contact Alan C. Moore at acmdoc@aol.com }
{ }
{ The contents of this file are used with permission, subject to }
{ the Mozilla Public License Version 1.1 (the "License"); you may }
{ not use this file except in compliance with the License. You may }
{ obtain a copy of the License at }
{ http://www.mozilla.org/MPL/MPL-1.1.html }
{ }
{ Software distributed under the License is distributed on an }
{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
{ implied. See the License for the specific language governing }
{ rights and limitations under the License. }
{ }
{******************************************************************}
unit HeadPars;
{$A+,B-,C-,D-,E-,F-,G-,H-,I-,L-,N-,O+,P-,Q-,R+,S+,T-,V-,X-}
interface
function HeadConvert(const FileName: String; Explicit: Boolean): Word;
{
return: 0 = success
1 = could not open the header file FileName.H
2 = output file (FileName.pas) already exists
}
implementation
uses
HeadVars, HeadUtil,
{$IFDEF MSDOS}
DOS
{$ELSE}
SysUtils
{$ENDIF};
function HeadConvert(const FileName: String; Explicit: Boolean): Word;
var
i,j,k: Integer;
{$IFDEF MSDOS}
var
Year,Month,Day,DayOfWeek,
Hour,Min,Sec,Sec100: Word;
{$ENDIF}
begin
HeadConvert := 0;
Str := FileName;
{$IFDEF MSDOS}
FSplit(FileName,Dir,DLL,Str);
Str := FileName;
{$ELSE}
Dir := ExtractFilePath(Str);
DLL := ExtractFileName(Str); { without .h extension }
{$ENDIF}
if (Pos('.',DLL) > 0) then DLL[0] := Chr(Pos('.',DLL)-1);
Upper(DLL);
System.Assign(header,Dir+DLL+'.h'); { only .h, no .H or .hpp }
System.reset(header);
if IOResult <> 0 then
begin
HeadConvert := 1;
Exit { could not open header file Dir+DLL+.H }
end;
{$IFNDEF MSDOS}
if FileExists(Dir+DLL+'.pas') then
begin
HeadConvert := 2;
Exit { output file (Dir+Pas+.pas) already exists }
end;
{$ENDIF}
Assign(output,Dir+DLL+'.~PA');
rewrite(output);
writeln('unit ',DLL,';');
writeln('{**************************************************************************}');
writeln('{','}':75);
writeln('{ This C DLL header file first (automatic) conversion generated by: }');
writeln('{ HeadConv 4.0 (c) 2000 by Bob Swart (aka Dr.Bob - www.drbob42.com) }');
writeln('{ Final Delphi-Jedi (Darth) command-line units edition }');
writeln('{','}':75);
{$IFDEF MSDOS}
GetDate(Year,Month,Day,DayOfWeek);
GetTime(Hour,Min,Sec,Sec100);
writeln('{ Generated Date: ',Year mod 100:2,'-',Zero2(Month),'-',Zero2(Day),'}':47);
writeln('{ Generated Time: ',Zero2(Hour),':',Zero2(Min),':',Zero2(Sec),'}':47);
{$ELSE}
writeln('{ Generated Date: ',DateToStr(Date):10,'}':45);
writeln('{ Generated Time: ',TimeToStr(Time):8,'}':47);
{$ENDIF}
writeln('{','}':75);
writeln('{**************************************************************************}');
writeln;
{!ACM -- More File processing }
System.Assign(def,Dir+DLL+'.~$$');
System.rewrite(def);
System.Assign(tmp,Dir+DLL+'.$$$');
System.rewrite(tmp);
{!ACM -- Code writing }
writeln('interface');
writeln('uses');
writeln('{$IFDEF WIN32}');
writeln(' Windows;');
writeln('{$ELSE}');
writeln(' Wintypes, WinProcs;');
writeln('{$ENDIF}');
writeln;
{!ACM -- Can we make the repeat..until into a routine? }
while (IOResult = 0) and not eof(header) do
begin
repeat
readln(header,Str);
ChangeTabs2Spaces(Str);
if Str = _START then Start := True
else
if Str = _STOP then Start := False;
if not Start then
begin
if Str <> _STOP then
writeln(Str) { don't convert }
end
else { Start }
begin
if Str <> _START then
begin
ChangeC2Pascal(Str);
SkipSpaces(Str);
if (Len = 0) then writeln(tmp)
end
else Str := '' { skip start }
end
until (IOResult <> 0) or eof(header) or (Len > 0);
{ writeln('[',Str,']'); { debug }
{!ACM -- Code similar to the next two lines occurs frequently from this point }
{!ACM -- on. Suggest we make these into descriptive boolean functions. This }
{!ACM -- one I would call CompilerDirectiveFound(). The advantage would be }
{!ACM -- that the logic of many nested conditional statements would be clarified}
com1 := Pos('#',Str);
if (com1 > 0) then { compiler directive }
{!ACM -- then I suggest putting the processing code into procedures that would }
{!ACM -- also have descriptive names like ProcessCompilerDirective() }
begin
{!ACM -- boolean function -- IncludeFound() }
com := Pos('#include',Str);
if (com > 0) and (com = com1) then
{!ACM -- procedure -- ProcessInclude() }
begin
Delete(Str,1,com+7);
SkipSpaces(Str);
writeln(tmp,'{$INCLUDE ',Str,'}')
end
else
begin
{!ACM -- boolean function -- IfTypeFound() }
com := Pos('#if',Str);
if (com > 0) and (com = com1) then
begin
{!ACM -- boolean function -- IfDefFound() }
if (Pos('#ifdef',Str) = com) and (com = com1) then
{!ACM -- Procedure -- ProcessIfDef }
begin
Delete(Str,1,com+5);
SkipSpaces(Str);
writeln(tmp,'{$IFDEF ',Str,'}')
end
else
begin
{!ACM -- boolean function -- IfNDefFound() }
if (Pos('#ifndef',Str) = com) and (com = com1) then
begin
{!ACM -- Procedure - ProcessIfNDef() }
Delete(Str,1,com+6);
SkipSpaces(Str);
writeln(tmp,'{$IFNDEF ',Str,'}')
end
else
begin
{!ACM -- boolean function - IfDefinedFound() }
if (Pos('#if defined',Str) = com) and (com = com1) then
begin
{!ACM -- Procedure - ProcessIfDefined }
Delete(Str,1,com+10);
SkipSpaces(Str);
if (Str[1] = '(') then
begin
Delete(Str,1,1);
SkipSpaces(Str);
if (Pos(')',Str) <> 0) then Delete(Str,Pos(')',Str),1)
end;
writeln(tmp,'{$IFDEF ',Str,'}')
end
else
begin
{!ACM -- boolean function - IfNotDefinedFound() }
if (Pos('#if !defined',Str) = com) and (com = com1) then
{!ACM -- Procedure ProcessIfNotDefined() }
{!ACM -- I am going to stop here for now so I can send this off and get }
{!ACM -- some feedback from both of you. I can figure out a lot of what is }
{!ACM -- going on but not all of it (never programmed in C -- just did some }
{!ACM -- translations from it to Pascal so there are some gaps. }
begin
Delete(Str,1,com+11);
SkipSpaces(Str);
if (Str[1] = '(') then
begin
Delete(Str,1,1);
SkipSpaces(Str);
if (Pos(')',Str) <> 0) then Delete(Str,Pos(')',Str),1)
end;
writeln(tmp,'{$IFNDEF ',Str,'}')
end
else { '#if' }
begin
Delete(Str,1,com+2);
SkipSpaces(Str);
writeln(tmp,'{$IFDEF ',Str,'}')
end
end
end
end
end
else
begin
com := Pos('#else',Str);
if (com = 0) then com := Pos('#elif',Str);
if (com > 0) and (com = com1) then
begin
Delete(Str,1,com+4);
SkipSpaces(Str);
if (Pos('!defined(',Str) > 0) and (com = com1) then
begin
Delete(Str,Pos('!defined(',Str),9);
Delete(Str,Pos(')',Str),1);
SkipSpaces(Str)
end
else
begin
if (Pos('defined(',Str) > 0) and (com = com1) then
begin
Delete(Str,Pos('defined(',Str),8);
Delete(Str,Pos(')',Str),1);
SkipSpaces(Str)
end
end;
if (Len > 0) then writeln(tmp,'{$ELSE ',Str,'}')
else writeln(tmp,'{$ELSE}')
end
else
begin
com := Pos('#endif',Str);
if (com > 0) and (com = com1) then
begin
Delete(Str,1,com+5);
SkipSpaces(Str);
if (Len > 0) then writeln(tmp,'{$ENDIF ',Str,'}')
else writeln(tmp,'{$ENDIF}')
end
else
begin
com := Pos('#define',Str);
if (com > 0) and (com = com1) then
begin
Delete(Str,1,com+6);
SkipSpaces(Str);
com := Pos(' ',Str);
if (com = 0) then { $DEFINE }
begin
writeln(tmp,'{$DEFINE ',Str,'}')
end
else { const }
begin
repeat
Delete(Str,com,1)
until (Str[com] <> ' ');
Insert('=',Str,com);
if (Str[com+1] = '0') and (UpCase(Str[com+2]) = 'X') then
begin { add '$' to hex numbers }
Delete(Str,com+1,1) { ' ' };
Str[com+1] := '$'
end;
com := Pos(' ',Str);
if (com = 0) then com := len+1;
Insert(';',Str,com);
i := Pos('=',Str);
while (i <= com) do
begin
Inc(i);
if (Str[i] in ['L','l','U','u','F','f']) and
(Str[i-1] in ['0'..'9','A'..'F']) and
not (Str[i+1] in IdentSet) then
begin
Delete(Str,i,1);
i := Len
end
end;
com := Pos('//',Str);
if (com > 0) then
begin
i := Pos('/*',Str);
if (i > 0) and (i < com) then com := i;
Insert('{',Str,com);
Insert('}',Str,len+1)
end
else
begin
com := Pos('/*',Str);
if (com > 0) then
begin
Insert('{',Str,com);
Insert('}',Str,len+1)
end
end;
com := Pos('=',Str);
Insert(' ',Str,com+1);
Insert(' ',Str,com);
writeln(tmp,'{} const ',Str)
end
end
else
begin
{ skip unknown '#' }
writeln(tmp,'{ ',Str,' }')
end
end
end
end
end
end
else { no '#' compiler directive }
begin
com := com1;
if (com <> 1) then com := Pos('//',Str);
if (com = 1) then
begin
writeln(tmp,'{/',Str,' }':76-Len);
Len := 0 { prevent comment from being written again... }
end
else { no comment }
begin
if (com > 0) then Len := com-1; { skip everything after '//' }
if (Len > 0) then
repeat
if not comment then
begin
com := Pos('/*',Str);
if (com = 1) then { start comment line }
begin
Str[2] := '/';
writeln(tmp,'{+',Str,' }':76-Len);
comment := Pos('*/',Str) = 0; { no reverse?? }
Len := 0; { prevent comment from being written again... }
com := 0 { hack }
end
else
begin
if (com > 0) then
begin { write everything before a comment }
for i:=1 to com-1 do
begin
write(tmp,Str[i]);
if (Str[i] in [';','{','}']) then writeln(tmp)
end;
Str := Copy(Str,com+2,len-com-1); { !!0.6!! }
comment := True
end
end
end
else { in comment }
begin
com := Pos('*/',Str);
if (Len > 1) and ((com+1) = Len) then { end comment line }
begin
Dec(Len,2);
writeln(tmp,'{=',Str,' }':76-Len);
comment := False;
Len := 0; { prevent comment from being written again... }
com := 0 { hack }
end
else { just another comment line... }
begin
if (com > 0) then
begin { skip everything in a comment }
Str := Copy(Str,com,len-com-1);
comment := False
end
end
end
until (com = 0) or (len = 0)
end;
if not comment then
begin
InArray := False;
LeadingSpace := True; { skip leading spaces on every line }
for i:=1 to Len do
begin
if Str[i] = '[' then InArray := True;
if Str[i] = ']' then InArray := False;
if InArray and (Str[i] = ' ') then
{ skip empty space v3.09 }
else
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -