program lexirom1;
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$D LexiROM1-Starter 12/02}
{$R lexirom1}
{$M 12000,0} {12/02}
{$S-,W-,I-}
{neue Version 06/00 erzeugt temporäres FOT-Verzeichnis}
uses WinProcs, WinTypes, Win31, ShellApi, WinDos, WUtils, ExeStart;
var
CurDir,FotName: TS255;
const
MsgBoxTitle='Autorun';
ExePath={$IFOPT D+}'U:\'+{$ENDIF}'lexrom\lexirom.exe';
procedure AddFontResources(add:Boolean);
const
FontLoc='\AAMSSTP\FONTS\*.*';
TempPrefix='LEXI';
var
sr: TSearchRec;
sp,sc,sf: PChar;
FontName: TS255;
begin
if Add then begin
GetTempFileName(#0,TempPrefix,0,FotName);
_ldelete(FotName); {erzeugte Datei löschen...}
CreateDir(FotName); {...und durch Verzeichnis ersetzen}
end;
sf:=FotName+lstrlen(FotName); {Zeiger auf die Null}
sf^:='\'; inc(sf); {ein Backslash dran und Zeiger dahinter}
lstrcpy(FontName,CurDir);
lstrcat(FontName,FontLoc);
sc:=FontName+lstrlen(FontName)-3;
FindFirst(FontName,0,sr);
while DosError=0 do begin
sp:=GetFileNameExt(sr.name);
if lstrcmpi(sp,'.TTF')=0 then begin
lstrcpy(sc,sr.name); {an FontName anhängen}
lstrcpy(sp,'.FOT'); {ersetzen}
lstrcpy(sf,sr.name); {an FotName anhängen}
if add then begin
CreateScalableFontResource(0,FotName,FontName,nil);
AddFontResource(FotName)
end else begin
RemoveFontResource(FotName);
_ldelete(FotName);
end;
end else if lstrcmpi(sp,'.FON')=0 then begin
if add then begin
AddFontResource(FontName)
end else begin
RemoveFontResource(FontName);
end;
end;
FindNext(sr);
end;
Dec(sf); sf^:=#0; {Backslash wieder abschnippeln}
if not Add then RemoveDir(FotName);
end;
procedure HandleLexinot;
{Falls .\lexinot.lst neuer als (windir)\lexinot.lst, auf šberschreiben fragen,
bei Bejahung berschreiben}
const
Lexinot='LEXINOT.LST';
var
windir: array[0..255] of Char;
DestTime: LongInt;
sr: TSearchRec;
begin
lstrcpy(windir+GetWindowsDirectory(windir,sizeof(windir)),'\'+Lexinot);
FindFirst(windir,0,sr);
if DosError=0 then begin {falls existiert, erst vergleichen}
if sr.attr and FAReadOnly <>0 then exit;
DestTime:=sr.time;
FindFirst(Lexinot,0,sr); {aktuelles Vrz.}
if DosError<>0 then exit; {keine Quelle!}
if (DestTime>=sr.time) then exit; {wenn neuer auf Platte: nichts tun!}
if (MessageBox(0,'LEXINOT.LST ist auf CD neuer als auf Platte'#10+
'(im Windows-Verzeichnis). Aktualisieren?',MsgBoxTitle,
MB_YesNo or MB_IconQuestion)<>IDYes) then exit;
{nichts tun, wenn User nicht will}
end;
if not CopyFile(Lexinot,windir,true)
then MessageBox(0,'Fehler bei Datei-Kopieraktion!',MsgBoxTitle,
MB_OK or MB_IconInformation);
end;
begin
{$IFOPT D+}
lstrcpy(CurDir,'U:');
{$ELSE}
GetModuleFileName(Seg(HInstance),CurDir,sizeof(CurDir));
PInteger(GetFileNamePtr(CurDir)-1)^:=0; {EXE-Name abhacken}
if lstrlen(CurDir)=2 then CurDir[2]:='\';
SetCurDir(CurDir);
if lstrlen(CurDir)=3 then CurDir[2]:=#0;
{$ENDIF}
if HPrevInst<>0 then begin
WinExec(ExePath,CmdShow); {dieses Programm verträgt keine zweite Instanz!}
halt;
end;
while CmdLine^=' ' do Inc(CmdLine);
if (lstrcmpi(CmdLine,'/autorun')<>0)
or (MessageBox(0,'LexiROM starten?',MsgBoxTitle,MB_YesNo or MB_IconQuestion)
=IDYes) then begin
HandleLexinot;
AddFontResources(true);
WritePrivateProfileString('Options','Drive',CurDir,'LEXIROM.INI');
{$IFOPT D+} asm int 3 end; {$ENDIF}
if ExecAndWait(ExePath,CmdShow,0)>=$4000
then MessageBox(0,'Fehler beim Start von LexiROM',MsgBoxTitle,MB_OK or MB_IconStop);
AddFontResources(false);
end;
end.
Vorgefundene Kodierung: UTF-8 | 0
|