unit wutils;
{Statische Bibliothek für Windows-typische Problemchen}
interface
uses WinProcs,WinTypes,ShellAPI;
{MessageBox-Funktionen auf Basis von unterteilten Ressourcen-Strings}
const
StdMBoxTitle: PChar = nil;
StdMBoxStyle: Word = MB_OK or MB_IconExclamation;
MB_Sound = $0080;
HKCR=HKEY_Classes_Root;
function MBox(WndParent:HWnd; ID:Word; var p):Integer;
function MBox1(WndParent:HWnd; ID:Word; S:PChar):Integer;
{Hinzufügen oder Entfernen von VxD's zur/aus SYSTEM.INI}
const
ARV_CantRemove = 1;
ARV_CantAdd = 2;
ARV_FailCreateTempFile = -2;
ARV_FailOpenSystemIni = -3;
ARV_FailReadWrite = -4;
ARV_FailDelete = -5;
ARV_FailRename = -6;
function AddRemoveVxD(AddPath,RemovVxD:PChar):Integer;
{AddPath bezeichnet ein neues VxD samt Pfad; NIL wenn kein neues}
{RemovVxD bezeichnet ein zu entfernendes VxD (kein Pfad erforderlich)}
{Registrierungs-Hilfen}
function RegSetRoot(Path,Value:PChar):Boolean;
function RegGetRoot(Path,Value:PChar; VL:Word):Boolean;
function WriteProfileInt(Section,Key:PChar; Value:Integer):Bool;
{Dateifunktionen}
function _ldelete(S: PChar):Integer;
function ExecAndWait(CmdLine:PChar; CmdShow:Word; Wnd:HWnd):Word;
{liefert um $4000 verschobenes WinExec-Resultat bei Fehler,
sonst Exitcode (im wesentlichen: LoByte auswerten!) des Programms}
function SetExeTermNotify(Wnd: HWnd; Msg:Word):Bool;
{Rückruf erfolgt mit PostMessage, wParam=Child-Instanz und lParam=Exit-Code.
Aufruf mit Wnd<>0 schaltet Callback ein, Wnd=0 schaltet Callback aus.
Kann nicht verschachtelt werden!}
procedure ShortYield;
function GetFileNamePtr(S:PChar):PChar;
{liefert Zeiger hinter das letzte Auftreten von /\: oder Stringanfang}
function GetFileNameExt(S:PChar):PChar;
{liefert Zeiger AUF DEN PUNKT oder AUF DIE NULL, niemals NIL}
function RemoveTrailSlash(S:PChar):PChar;
{liefert Zeiger AUF DIE NULL, entfernt ggf. mehr als 1 Slash}
{Zip/Unzip-Hilfe - Start von unsichtbaren DOS-Boxen}
type
TPIF=record
rsv000: Byte; {=$00}
Checksum: Byte; {Prüfsumme, Summe der Bytes von Offset 002..170}
Title: array[0..29] of Char; {Titel, mit Leerzeichen aufgefüllt}
rsv020: Word; {=$0080}
ReqConvK: Word; {Erforderlicher konventioneller Speicher}
ExeFile: array[0..62] of Char; {Ausführbarer Dateiname, nullterminiert,
MIT PFAD & ENDUNG!}
SmFlag1: Word; {=$0010,
{ Bit4=Fenster schließen beim Beenden}
{ Bit}
WorkDir: array[0..63] of Char; {Arbeitsverzeichnis, nullterminiert}
SMParams: array[0..63] of Char; {Programm-Parameter, nullterminiert, Standard Mode}
rsv0E5: Word; {=$0100}
rsv0E7: Word; {=$FF00}
rsv0E9: Word; {=$5019}
rsv0EB: Word; {=$0000}
SmFlag2: Word; {=$0007}
{ Bit4=Grafik/Mehrfachtext}
rsv0EF: array[0..63] of Word; {lauter Nullen}
SmFlag3: Word; {=$60E0}
{Hier beginnt die Enhanced-Mode-Sektion}
Magic1: array[0..15] of Char; {"MICROSOFT PIFEX"}
rsv181: Word; {=$0187}
rsv183: Word; {=$0000}
rsv185: Word; {=$0171}
Magic2: array[0..15] of Char; {"WINDOWS 386 3.0"}
rsv197: Word; {=$0205}
rsv199: Word; {=$019D}
rsv19B: Word; {=$0068}
V86MaxK: Word; {=$0280}
V86MinK: Word; {=$0080}
PriFore: Word; {=$0064 Vordergrundpriorität}
PriBack: Word; {=$0032 Hintergrundpriorität}
EmsMaxK: Word; {=$FFFF Max EMS (386Enh)}
EmsMinK: Word; {=$0000 Min EMS}
XmsMaxK: Word; {=$FFFF Max XMS}
XmsMinK: Word; {=$0000 Min XMS}
InfoShell: LongInt; {=$00025002}
InfoVDD: LongInt; {=$0000001F}
VKD_ScanCode: Word; {=$0000}
VKD_Mask: LongInt; {=$00000000}
rsv1BB: array[0..4] of Word; {lauter Nullen}
EMParams: array[0..63] of Char; {Programm-Parameter, nullterminiert, Enhanced Mode}
{Hier beginnt die Standard-Mode-Erweiterung}
Magic3: array[0..15]of Char; {"WINDOWS 286 3.0"}
rsv215: Word; {=$FFFF}
rsv217: Word; {=$021B}
rsv219: Word; {=$0006}
SmXmsMaxK: Word; {=$FFFF Max XMS}
SmXmsMinK: Word; {=$0000 Min XMS}
SmFlag4: Word; {=$0000}
end;
{***************
;VDD PIF_State service definitions
;
; These definitions cannot change without changing the PIF editor!!!
;}
const
fVidTxtEmulate = $00000001; { Do INT 10h TTY and cursor emulation}
fVidNoTrpTxt = $00000002; { Do not trap text mode apps}
fVidNoTrpLRGrfx= $00000004; { Do not trap lo res graphics mode apps}
fVidNoTrpHRGrfx= $00000008; { Do not trap hi res graphics mode apps}
fVidTextMd = $00000010; { Allocate text mode mem}
fVidLowRsGrfxMd= $00000020; { Allocate lo res graphics mode mem}
fVidHghRsGrfxMd= $00000040; { Allocate hi res graphics mode mem}
fVidRetainAllo = $00000080; { Never deallocate once allocated}
{
Bits of returned EAX flags for SHELL_GetVMInfo service
}
{ SGVMI_Windowed = $00000004 { Is Windowed}
VMI_CloseOnExit = $00000001;
VMI_RunBackground= $00000002;
VMI_RunExclusive = $00000004;
VMI_RunFullscreen= $00000008;
SGVMI_ALTTABdis = $00000020; { Alt+Tab is reserved}
SGVMI_ALTESCdis = $00000040; { Alt+Esc is reserved}
SGVMI_ALTSPACEdis= $00000080; { Alt+Space is reserved}
SGVMI_ALTENTERdis= $00000100; { Alt+Enter is reserved}
SGVMI_ALTPRTSCdis= $00000200; { Alt+PrtSc is reserved}
SGVMI_PRTSCdis = $00000400; { PrtSc is reserved}
SGVMI_CTRLESCdis = $00000800; { Ctrl+Esc is reserved}
SGVMI_Polling = $00001000; { Polling detection Enab}
SGVMI_NoHMA = $00002000; { No HMA}
SGVMI_HasHotKey = $00004000; { Has a shortcut key}
SGVMI_EMS_Lock = $00008000; { EMS Hands Locked}
SGVMI_XMS_Lock = $00010000; { XMS Hands Locked}
SGVMI_FastPaste = $00020000; { Allow Fast paste Enab}
SGVMI_V86_Lock = $00040000; { V86 Memory Locked}
VKD_ShiftMask = $000F0003;
VKD_CtrlMask = $000F0004;
VKD_AltMask = $000F0008;
F1_GraphicsSave= $0002;
F1_NoTaskswitch= $0004;
F1_NoPRTSC = $0008;
F1_CloseOnExit = $0010;
F1_COM2_Lock = $0040;
F1_COM1_Lock = $0080;
F2_Default = $0007;
F2_GraphicsSave= $0010;
F3_Default = $60E0;
F3_Modify_Kbd = $0010;
F4_ALTTABdis = $0001;
F4_ALTESCdis = $0002;
F4_ALTPRTSCdis = $0004;
F4_PRTSCdis = $0008;
F4_CTRLESCdis = $0010;
F4_COM3_Lock = $4000;
F4_COM4_Lock = $8000;
function CreatePIF(Title,ExeFile,Params,WorkDir:PChar;
var PIF:TPif):Integer;
{WorkDir ist das TEMP-Verzeichnis, wenn NIL}
{FileName liefert(!) den Dateinamen im TEMP-Verzeichnis, falls leer}
{Title kann eine String-Ressource-ID sein: mit MakeIntResource() übergeben!}
type HFile=Integer; {fehlt bei BP7}
const HFile_Error=-1; {fehlt bei BP7}
type
LongRec=record
Lo,Hi:Word;
end;
WordRec=record
Lo,Hi:Byte;
end;
procedure AHIncr;
procedure __0040H;
function _hread(f:HFile;Buf:PChar;BufLen:LongInt):LongInt;
function _hwrite(f:HFile;Buf:PChar;BufLen:LongInt):LongInt;
implementation
uses Strings,Win31,ToolHelp;
function MBox(WndParent:HWnd; ID:Word; var p):Integer;
{** NICHT OK für DLL **}
var
S,S2: array[0..255]of Char; {2 Puffer; leider so erforderlich}
SPT,SPH: PChar; {Zeiger auf Text und Titel}
I,K: Integer;
TextType:Word;
begin
TextType:=StdMBoxStyle;
I:=LoadString(HInstance,ID,S,sizeof(S)); {I=Anzahl der Zeichen insgesamt}
SPT:=S;
if S[0]='$' then begin
Val(S,TextType,K);
SPT:=S+lStrLen(S)+1;
end;
SPH:=SPT+lStrLen(SPT)+1;
if SPH-S>I then SPH:=StdMBoxTitle;
wvsprintf(S2,SPT,P);
if TextType and MB_Sound <>0 then MessageBeep(TextType and $0070);
MBox:=MessageBox(WndParent,S2,SPH,TextType and not MB_Sound);
end;
function MBox1(WndParent:HWnd; ID:Word; S:PChar):Integer;
{** NICHT OK für DLL **}
begin
MBox1:=MBox(WndParent,ID,S);
end;
function AddRemoveVxD(AddPath,RemovVxD:PChar):Integer;
{** OK für DLL **}
const
devkey: array[0..7]of Char='device=';
var
f1,f2: Text; {zum SYSTEM.INI parsen}
S,Line: array[0..255]of Char;
PS,PL: PChar;
InsideSection,CopyLine: Boolean;
W: Word;
begin
WritePrivateProfileString(nil,nil,nil,'SYSTEM.INI'); {Cache leeren}
W:=GetWindowsDirectory(S,sizeof(S));
if S[W-1]<>'\' then begin S[W]:='\'; S[W+1]:=#0; end; {Backslash anhängen}
PS:=S+lStrLen(S); {auf die Null}
lStrCpy(PS,'SYSTEM.IN$'); {Tempname anhängen}
Assign(f2,S); ReWrite(f2); {zum Schreiben öffnen}
if IOResult<>0 then begin
AddRemoveVxD:=ARV_FailCreateTempFile;
exit;
end;
lStrCpy(PS,'SYSTEM.INI'); {Richtigen Namen anhängen}
Assign(f1,S); Reset(f1); {zum Lesen öffnen}
if IOResult<>0 then begin
AddRemoveVxD:=ARV_FailOpenSystemIni;
exit;
end;
InsideSection:=false;
while not eof(f1) do begin
ReadLn(f1,Line); CopyLine:=true;
if Line[0]='[' then begin
InsideSection:=(StrLIComp(Line,'[386Enh]',8)=0);
if InsideSection and (AddPath<>nil) then begin
WriteLn(f2,Line); {Sektionsbeginn beibehalten}
WriteLn(f2,devkey,AddPath); {Neue Zeile hinzufügen}
AddPath:=nil; {Einmal hinzufügen genügt}
CopyLine:=false; {nichts weiter...}
end;
end else begin
if InsideSection
and (RemovVxD<>nil)
and (StrLIComp(Line,devkey,7)=0)
and (lStrCmpi(GetFileNamePtr(Line+7),RemovVxD)=0) then begin
CopyLine:=false;
RemovVxD:=nil; {erledigt}
end;
end;
if CopyLine then WriteLn(f2,Line);
end;
Close(f1); Close(f2);
if IOResult<>0 then begin
AddRemoveVxD:=ARV_FailReadWrite;
exit; {Problem! Quelle nicht löschen!}
end;
Erase(f1); {Quelle löschen}
if IOResult<>0 then begin
AddRemoveVxD:=ARV_FailDelete;
exit;
end;
ReName(f2,S); {Ziel umbenennen}
if IOResult<>0 then begin
AddRemoveVxD:=ARV_FailRename;
exit;
end;
AddRemoveVxD:=0;
if RemovVxD<>nil then AddRemoveVxD:=ARV_CantRemove;
if AddPath<>nil then AddRemoveVxD:=ARV_CantAdd;
end;
function RegSetRoot(Path,Value:PChar):Boolean;
{** OK für DLL **}
begin
RegSetRoot:=(RegSetValue(HKCR,Path,REG_SZ,Value,
lstrlen(Value))=ERROR_SUCCESS);
end;
function RegGetRoot(Path,Value:PChar; VL:Word):Boolean;
{** OK für DLL **}
var
cb: LongInt;
begin
cb:=VL;
RegGetRoot:=(RegQueryValue(HKCR,Path,Value,cb)
=ERROR_SUCCESS);
end;
function WriteProfileInt(Section,Key:PChar; Value:Integer):Bool;
{** OK für DLL **}
var
S: array[0..7]of Char;
begin
wvsprintf(S,'%d',Value);
WriteProfileString(Section,Key,S);
end;
function _ldelete(S: PChar):Integer; assembler;
{** OK für DLL **}
asm
push ds
lds dx,[S]
mov ah,$41
call Dos3Call
pop ds
end;
var
ProcInst: TFarProc;
ThisTask: THandle;
ChildInst: THandle;
const
NotifyWnd: HWnd=0;
Blocked: Bool=false;
var
NotifyMsg: Word;
function NotifyCallback(ID:Word; Data:LongInt):Bool; far;
{Achtung! Smart Callback funktioniert hier NICHT!
Toolhelp ruft diese Funktion, ohne das SS-Register aufs Datensegment
zu setzen, leider. Lösung:
* Single-Instance-Application (hier)
- "mov ds,seg @data"
- "export" ist sinnlos, es genügt "far"; dann muß DS gerettet werden
* Multiple-Instance-Application (z.B. VTW)
- Verwendung von MakeProcInstance() und FreeProcInstance() erforderlich
- $K- schalten oder (da dieser Schalter leider global ist)
- "export" durch "far" ersetzen und am Eintritt den Assemblerbefehl
"mov ds,ax" setzen. Nicht vergessen, DS zu retten}
{** NICHT OK für DLL **}
var
TE: TTaskEntry;
begin
asm push ds
mov ds,ax
end;
if ID=NFY_ExitTask then begin
TE.dwSize:=sizeof(TE);
TaskFindHandle(@TE,GetCurrentTask);
if TE.hTaskParent=ThisTask then begin
if Blocked and (TE.hInst=ChildInst) then begin
Blocked:=false; {unblock}
ChildInst:=LongRec(Data).Lo; {Returncode}
end else if NotifyWnd<>0
then PostMessage(NotifyWnd,NotifyMsg,TE.hInst,Data);
end;
end;
NotifyCallback:=false;
asm pop ds end;
end;
function ExecAndWait(CmdLine:PChar; CmdShow:Word; Wnd:HWnd):Word;
{** NICHT OK für DLL **}
var
OldWndCurs:HCursor;
begin
if NotifyWnd=0 then begin
ProcInst:=MakeProcInstance(@NotifyCallback,Seg(HInstance));
NotifyRegister(0,TNotifyCallback(ProcInst),NF_Normal);
ThisTask:=GetCurrentTask;
end;
OldWndCurs:=SetClassWord(Wnd,GCW_HCursor,LoadCursor(0,IDC_Wait));
ChildInst:=WinExec(CmdLine,CmdShow);
{Problem: Callback könnte vor(!) der Rückkehr von WinExec()
aufgerufen werden! Dann würde ExecAndWait() ewig warten}
if ChildInst>=32 then begin
Blocked:=true;
EnableWindow(Wnd,false); {Keine Tastatur, keine Maus!}
while Blocked do ShortYield; {Warten auf Child-Ende}
EnableWindow(Wnd,true);
end else Inc(ChildInst,$4000);{Fehlercode-Offset bei Fehler dazu}
SetClassWord(Wnd,GCW_HCursor,OldWndCurs);
if NotifyWnd=0 then begin
NotifyUnregister(0);
FreeProcInstance(ProcInst);
end;
ExecAndWait:=ChildInst; {0 wenn erfolgreich}
end;
function SetExeTermNotify(Wnd: HWnd; Msg:Word):Bool;
{** NICHT OK für DLL **}
begin
SetExeTermNotify:=true;
if Wnd<>0 then begin
if NotifyWnd=0 then begin
ProcInst:=MakeProcInstance(@NotifyCallback,Seg(HInstance));
SetExeTermNotify:=NotifyRegister(0,TNotifyCallback(ProcInst),NF_Normal);
ThisTask:=GetCurrentTask;
end;
end else begin
if NotifyWnd<>0 then begin
NotifyUnregister(0);
FreeProcInstance(ProcInst);
end;
end;
NotifyWnd:=Wnd;
NotifyMsg:=Msg;
end;
procedure ShortYield;
{** OK für DLL **}
var
Msg: TMsg;
begin
if PeekMessage(Msg,0,0,0,PM_Remove) then begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
function CreatePIF(Title,ExeFile,Params,WorkDir:PChar;
var PIF:TPif):Integer;
{** NICHT OK für DLL **}
const
APIF:TPIF=(
rsv000: $00;
Checksum: $00;
Title: '(No Title) ';
rsv020: $0080;
ReqConvK: $0080;
ExeFile: '%COMSPEC%';
SmFlag1: $0010;
WorkDir: '';
SMParams: '';
rsv0E5: $0100;
rsv0E7: $FF00;
rsv0E9: $5019;
rsv0EB: $0000;
SmFlag2: $0007;
rsv0EF:( 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
SmFlag3: $60E0;
Magic1: 'MICROSOFT PIFEX'#0;
rsv181: $0187;
rsv183: $0000;
rsv185: $0171;
Magic2: 'WINDOWS 386 3.0'#0;
rsv197: $0205;
rsv199: $019D;
rsv19B: $0068;
V86MaxK: $0280;
V86MinK: $0080;
PriFore: $0400; {Hohe Prioritäten}
PriBack: $0400;
EmsMaxK: $FFFF;
EmsMinK: $0000;
XmsMaxK: $FFFF;
XmsMinK: $0000;
InfoShell: $00025002; {im Fenster! (sonst wirkt SW_Hide nicht)}
InfoVDD: $0000001F;
VKD_ScanCode: $0000;
VKD_Mask: $00000000;
rsv1BB:( 0,0,0,0,0);
EMParams: '';
Magic3: 'WINDOWS 286 3.0'#0;
rsv215: $FFFF;
rsv217: $021B;
rsv219: $0006;
SmXmsMaxK: $FFFF;
SmXmsMinK: $0000;
SmFlag4: $0000);
begin
Pif:=APif; {Struktur kopieren}
if LongRec(Title).Hi<>0 then begin
lstrcpyn(Pif.Title,Title,sizeof(Pif.Title)-1);
(Pif.Title+lstrlen(Pif.Title))^:=' '; {"blank padded"}
end else if LongRec(Title).Lo<>0 then begin
(Pif.Title+LoadString(Seg(HInstance),LongRec(Title).Lo,
Pif.Title,sizeof(Pif.Title)-1))^:=' ';
end;
if ExeFile<>nil
then lstrcpyn(Pif.ExeFile,ExeFile,sizeof(Pif.ExeFile)-1);
if Params<>nil then begin
lstrcpyn(Pif.SMParams,Params,sizeof(Pif.SMParams)-1);
lstrcpyn(Pif.EMParams,Params,sizeof(Pif.EMParams)-1);
end;
if WorkDir<>nil
then lstrcpyn(Pif.WorkDir,WorkDir,sizeof(Pif.WorkDir)-1);
end;
function GetFileNamePtr(S:PChar):PChar; assembler;
{** OK für DLL **}
{liefert Zeiger hinter das letzte Auftreten von /\: oder Stringanfang}
asm les si,[S]
cld
@@ME: mov dx,si {Mögliches Ende merken}
@@l: seges lodsb
cmp al,'\'
jz @@ME
cmp al,'/'
jz @@ME
cmp al,':'
jz @@ME
or al,al
jnz @@l
mov ax,es
xchg dx,ax
end;
function GetFileNameExt(S:PChar):PChar; assembler;
{** OK für DLL **}
{liefert Zeiger AUF DEN PUNKT oder AUF DIE NULL, niemals NIL}
asm les si,[S]
cld
@@ME: xor ah,ah {Punkt-gefunden-Flag}
@@m1: mov dx,si
@@l: seges lodsb
cmp al,'\'
jz @@me
cmp al,'\'
jz @@me
cmp al,':'
jz @@me
cmp al,'.'
jnz @@kp
inc ah
jmp @@l {Adresse AUF dem Punkt merken}
@@kp: or al,al
jz @@e {fertig}
or ah,ah
jnz @@l {nicht fertig und zuletzt '.'}
jmp @@m1 {nicht fertig und zuletzt '\/:'}
@@e: mov ax,es
xchg dx,ax
end;
function RemoveTrailSlash(S:PChar):PChar; assembler;
{** OK für DLL **}
{liefert Zeiger AUF DIE NULL, entfernt MAX. 1 Slash!}
asm les di,[S]
cld
xor ax,ax
mov dx,si
mov cx,$FFFF
repne scasb {ES:DI hinter die Null}
dec di {auf die Null}
@@l: mov al,es:[di]
cmp al,'\'
jz @@1
cmp al,'/'
jnz @@e
@@1: cmp di,dx
jnc @@l
{di=Stringanfang und alles '/\'}
dec di
@@e:{Sonstiges Zeichen erreicht}
inc di
mov byte ptr es:[di],ah
mov dx,es
xchg ax,di
end;
procedure AHIncr; external 'KERNEL' index 114;
procedure __0040H; external 'KERNEL' index 193;
function _hread; external 'KERNEL' index 349;
function _hwrite; external 'KERNEL' index 350;
end.
{Müll}
type
TMemTextParse=record
a,c,e,max:PChar;
{a=Anfang, c=Cursor, e=Text-Ende, max=Speicher-Ende}
end;
function IsCharWhite(C:Char):Bool;
function NextLine(var mtp:TMemTextParse):Boolean;
{...verschiebt den Cursor auf den Anfang der nächsten Zeile}
function DelLine(var mtp:TMemTextParse):Boolean;
{...löscht die Zeile ab Cursor inkusive CRLF}
function InsertLine(var mtp:TMemTextParse; S:PChar):Boolean;
{...fügt eine Zeile ab Cursor inklusive CRLF ein}
function GetTrimmedLine(var mtp:TMemTextParse; S:PChar; SL:Word):Boolean;
{...holt eine Zeile, die von Leerzeichen an Anfang und Ende befreit ist}
{Speichertextverwaltungs-Funktionen}
function IsCharWhite(C:Char):Bool;
begin
IsCharWhite:= (C=' ')or(C=#9);
end;
function NextLine(var mtp:TMemTextParse):Boolean;
begin
NextLine:=false;
if mtp.c=mtp.e then exit; {Keine neue Zeile folgt}
while mtp.c^<>#10 do begin
mtp.c:=AnsiNext(mtp.c);
if mtp.c=mtp.e then exit; {Keine neue Zeile folgt}
end;
if ((mtp.c=mtp.a) or ((mtp.c-1)^<>#13)) {wenn kein #13 davor...}
and ((mtp.c+1)^=#13) {dann vielleicht dahinter...}
then Inc(mtp.c); {dann ist DIES das Zeilenende!}
Inc(mtp.c); {Der neue Zeilenanfang}
if mtp.c=mtp.e then exit; {keine echte Zeile!}
NextLine:=true;
end;
function DelLine(var mtp:TMemTextParse):Boolean;
var
c1: PChar;
begin
DelLine:=false;
c1:=mtp.c; {Cursor merken}
if c1=mtp.e then exit; {Nichts zu löschen da!}
NextLine(mtp); {Cursor auf neue Zeile}
Move(mtp.c,c1,mtp.e-mtp.c); {"Schwanz" bewegen}
Dec(mtp.e,mtp.c-c1); {Ende verkürzen}
mtp.c:=c1; {Cursor setzen}
DelLine:=true;
end;
function InsertLine(var mtp:TMemTextParse; Key,Value:PChar):Boolean;
var
len: Word;
LenKey,LenVal:Word;
begin
InsertLine:=false;
if Key=nil then exit;
LenKey:=lStrLen(Key);
len:=KenKey+3; {Einfüge-Länge}
LenVal:=$FFFF; if Value<>nil then LenVal:=lstrlen(Value);
Inc(len,LenVal); {aus Key und Value}
if mtp.max<mtp.e+len then exit; {Speichermangel}
Move(mtp.c,mtp.c+len,mtp.e-mtp.c); {"Schwanz" bewegen}
Inc(mtp.e,len); {Ende verlängern}
Move(Key,mtp.c,LenKey);
Inc(mtp.c,LenKey);
if LenVal<>$FFFF then begin
mtp.c^:='=';
Inc(mtp.c);
Move(Value,mtp.c,LenVal);
Inc(mtp.c,LenVal);
end;
PWord(mtp.c-2)^:=#1013; {CRLF einpatchen}
Inc(mtp.c,2); {Cursor dahinter}
InsertLine:=true;
end;
function GetIniLine(var mtp:TMemTextParse; Sec,Key,Value:PChar; VL:Word):Boolean;
var
c1,c2,c3: PChar;
begin
GetTrimmedLine:=false;
if mtp.c=mtp.e then exit; {Ende erreicht}
c1:=mtp.c; {Cursor merken}
NextLine(mtp); {Nächste Zeile oder Ende ansteuern}
c3:=mtp.c; {"Hilfs-Ende"}
while (c1<mtp.c) and IsCharWhite(c1^) do Inc(c1); {"TrimLeft"}
if (c1<mtp.c) and c1^='[' then
while c1<c3 do begin
c2:=AnsiPrev(c1,c3);
if IsCharWhite(c2^) or (c2^=#13) or (c2^=#10)
then c3:=c2; {weitermachen}
else break; {Stop, c3 zeigt aufs String-Ende}
end;
if SL>c3-c1 then SL:=c3-c1;
lstrcpyn(S,c1,SL);
GetTrimmedLine:=true;
end;
| Detected encoding: OEM (CP437) | 1
|
|
|