You've already forked lazarus-ccr
20080301 release: Minor adjustments to converters; expanded notes to help users who are new to Lazarus.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@366 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
macpgmr
227
components/xdev_toolkit/makepasx.pas
Normal file
227
components/xdev_toolkit/makepasx.pas
Normal file
@@ -0,0 +1,227 @@
|
||||
program MakePasX;
|
||||
|
||||
{
|
||||
Makes Delphi form code file or project file cross-platform
|
||||
so it can be compiled by both Delphi and Lazarus/FPC.
|
||||
Note that this is a one-time conversion.
|
||||
Note: Use DfmToLfm to convert form's design file to LCL
|
||||
whenever changes are made to form in Delphi.
|
||||
|
||||
Author: Phil Hess.
|
||||
Copyright: Copyright (C) 2007 Phil Hess. All rights reserved.
|
||||
License: Modified LGPL.
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$ELSE}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
{$R+,Q+}
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
const
|
||||
ProgramName = 'MakePasX';
|
||||
ProgramVersion = '0.02';
|
||||
|
||||
PasFileExt = '.pas'; {Pascal code file extension}
|
||||
DelProjFileExt = '.dpr'; {Delphi project file extension}
|
||||
TmpFileExt = '.tmp'; {Create converted file with this extension}
|
||||
BakFileExt = '.bak'; {Rename original file with this extension}
|
||||
|
||||
var
|
||||
OldFileName : string;
|
||||
NewFileName : string;
|
||||
OldFileVar : TextFile;
|
||||
NewFileVar : TextFile;
|
||||
{$IFNDEF FPC}
|
||||
MatchFound : TFilenameCaseMatch;
|
||||
{$ENDIF}
|
||||
IsProject : Boolean;
|
||||
InStr : string;
|
||||
FoundUses : Boolean;
|
||||
Done : Boolean;
|
||||
UnitPos : Integer;
|
||||
HasAppInit : Boolean;
|
||||
HasForm : Boolean;
|
||||
|
||||
begin
|
||||
|
||||
if ParamCount = 0 then {List program useage?}
|
||||
begin
|
||||
WriteLn(ProgramName, ', version ', ProgramVersion,
|
||||
' - makes Delphi code file cross-platform.');
|
||||
WriteLn('Usage: ', ProgramName, ' filename[', PasFileExt, '|',
|
||||
DelProjFileExt, ']');
|
||||
Halt;
|
||||
end;
|
||||
|
||||
{Get name of Pascal code file to convert from command line}
|
||||
OldFileName := ParamStr(1);
|
||||
if ExtractFileExt(OldFileName) = '' then {No extension?}
|
||||
OldFileName := OldFileName + PasFileExt; {Assume it's not a project file}
|
||||
{$IFNDEF FPC}
|
||||
OldFileName := ExpandFileNameCase(OldFileName, MatchFound);
|
||||
{$ELSE}
|
||||
OldFileName := ExpandFileName(OldFileName);
|
||||
{$ENDIF}
|
||||
|
||||
IsProject := CompareText(ExtractFileExt(OldFileName), DelProjFileExt) = 0;
|
||||
|
||||
NewFileName := ChangeFileExt(OldFileName, TmpFileExt);
|
||||
|
||||
{Open code file}
|
||||
AssignFile(OldFileVar, OldFileName);
|
||||
try
|
||||
Reset(OldFileVar);
|
||||
except
|
||||
on EInOutError do
|
||||
begin
|
||||
WriteLn('Can''t open Pascal code file ', OldFileName);
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
{Create new code file}
|
||||
AssignFile(NewFileVar, NewFileName);
|
||||
try
|
||||
Rewrite(NewFileVar);
|
||||
except
|
||||
on EInOutError do
|
||||
begin
|
||||
WriteLn('Can''t create new code file ', NewFileName);
|
||||
Halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
FoundUses := False;
|
||||
HasAppInit := False;
|
||||
HasForm := False;
|
||||
while not Eof(OldFileVar) do {Read and convert Pascal code file}
|
||||
begin
|
||||
ReadLn(OldFileVar, InStr); {Read line of code}
|
||||
|
||||
if not IsProject then {Form code file?}
|
||||
begin
|
||||
if (CompareText(InStr, 'uses') = 0) and {Found uses section?}
|
||||
(not FoundUses) then {And in interface section?}
|
||||
begin {Note assumes "uses" appears on separate line from list of units}
|
||||
FoundUses := True;
|
||||
WriteLn(NewFileVar, InStr);
|
||||
WriteLn(NewFileVar,
|
||||
' {$IFNDEF LCL} Windows, Messages, ',
|
||||
'{$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}');
|
||||
ReadLn(OldFileVar, InStr);
|
||||
repeat
|
||||
UnitPos := Pos('WINDOWS,', UpperCase(InStr));
|
||||
if UnitPos > 0 then
|
||||
Delete(InStr, UnitPos, 8);
|
||||
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||
Delete(InStr, UnitPos, 1);
|
||||
UnitPos := Pos('MESSAGES,', UpperCase(InStr));
|
||||
if UnitPos > 0 then
|
||||
Delete(InStr, UnitPos, 9);
|
||||
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||
Delete(InStr, UnitPos, 1);
|
||||
UnitPos := Pos('WINTYPES,', UpperCase(InStr)); {Synonym for Windows}
|
||||
if UnitPos > 0 then
|
||||
Delete(InStr, UnitPos, 9);
|
||||
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||
Delete(InStr, UnitPos, 1);
|
||||
UnitPos := Pos('WINPROCS,', UpperCase(InStr)); {Synonym for Windows}
|
||||
if UnitPos > 0 then
|
||||
Delete(InStr, UnitPos, 9);
|
||||
if Copy(InStr, UnitPos, 1) = ' ' then
|
||||
Delete(InStr, UnitPos, 1);
|
||||
WriteLn(NewFileVar, InStr);
|
||||
Done := Pos(';', InStr) > 0;
|
||||
if not Done then
|
||||
ReadLn(OldFileVar, InStr);
|
||||
until Done;
|
||||
end {uses section}
|
||||
|
||||
else if CompareText(Copy(Trim(InStr), 1, 10),
|
||||
'{$R *.dfm}') = 0 then {Form's resource file?}
|
||||
begin
|
||||
WriteLn(NewFileVar, '{$IFNDEF LCL}');
|
||||
WriteLn(NewFileVar, InStr);
|
||||
WriteLn(NewFileVar, '{$ENDIF}');
|
||||
HasForm := True;
|
||||
end
|
||||
|
||||
else if (CompareText(InStr, 'end.') = 0) and HasForm then {End of unit?}
|
||||
begin
|
||||
{Note: Make sure IFDEF goes after initialization since Delphi
|
||||
inserts new event handlers immediately before initialization line.}
|
||||
WriteLn(NewFileVar, 'initialization');
|
||||
WriteLn(NewFileVar, '{$IFDEF LCL}');
|
||||
WriteLn(NewFileVar, '{$I ', ChangeFileExt(ExtractFileName(OldFileName),
|
||||
'.lrs} {Include form''s resource file}'));
|
||||
WriteLn(NewFileVar, '{$ENDIF}');
|
||||
WriteLn(NewFileVar);
|
||||
WriteLn(NewFileVar, InStr);
|
||||
end
|
||||
|
||||
else {Nothing to change with this line}
|
||||
WriteLn(NewFileVar, InStr);
|
||||
end
|
||||
|
||||
else {Delphi project file}
|
||||
begin
|
||||
if (CompareText(InStr, 'uses') = 0) and {Found uses section?}
|
||||
(not FoundUses) then {And in interface section?}
|
||||
begin {Note assumes "uses" appears on separate line from list of units}
|
||||
FoundUses := True;
|
||||
WriteLn(NewFileVar, InStr);
|
||||
WriteLn(NewFileVar, '{$IFDEF LCL}');
|
||||
WriteLn(NewFileVar, ' Interfaces,');
|
||||
WriteLn(NewFileVar, '{$ENDIF}');
|
||||
end
|
||||
else if (CompareText(Copy(Trim(InStr), 1, 10), '{$R *.res}') = 0) or
|
||||
(CompareText(Copy(Trim(InStr), 1, 10), '{$R *.r32}') = 0) or
|
||||
(CompareText(Copy(Trim(InStr), 1, 10), '{$R *.r16}') = 0) then
|
||||
begin {Program's resource file}
|
||||
WriteLn(NewFileVar, '{$IFDEF MSWINDOWS}');
|
||||
WriteLn(NewFileVar, InStr);
|
||||
WriteLn(NewFileVar, '{$ENDIF}');
|
||||
end
|
||||
else if CompareText(Copy(Trim(InStr), 1, 3), '{$R') = 0 then
|
||||
begin {Might be a type library or XP manifest resource file}
|
||||
WriteLn(NewFileVar, '{$IFNDEF FPC}');
|
||||
WriteLn(NewFileVar, InStr);
|
||||
WriteLn(NewFileVar, '{$ENDIF}');
|
||||
end
|
||||
else if Pos('APPLICATION.INITIALIZE', UpperCase(InStr)) > 0 then
|
||||
begin
|
||||
HasAppInit := True;
|
||||
WriteLn(NewFileVar, InStr);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (not HasAppInit) and
|
||||
((Pos('APPLICATION.CREATEFORM', UpperCase(InStr)) > 0) or
|
||||
(Pos('APPLICATION.RUN', UpperCase(InStr)) > 0)) then
|
||||
begin
|
||||
WriteLn(NewFileVar, ' Application.Initialize;'); {Laz needs this}
|
||||
HasAppInit := True;
|
||||
end;
|
||||
WriteLn(NewFileVar, InStr);
|
||||
end;
|
||||
end;
|
||||
|
||||
end; {while not Eof}
|
||||
|
||||
DeleteFile(ChangeFileExt(OldFileName, BakFileExt));
|
||||
CloseFile(OldFileVar);
|
||||
RenameFile(OldFileName, ChangeFileExt(OldFileName, BakFileExt));
|
||||
CloseFile(NewFileVar);
|
||||
if not IsProject then
|
||||
RenameFile(NewFileName, ChangeFileExt(NewFileName, PasFileExt))
|
||||
else
|
||||
RenameFile(NewFileName, ChangeFileExt(NewFileName, DelProjFileExt));
|
||||
WriteLn(OldFileName, ' successfully converted.');
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user