Quelltext /~heha/hs/kcemu/kcemusrc.zip/WUTILS.PAS

unit wutils;
{Statische Bibliothek für Windows-typische Problemchen}
{$C MOVEABLE PRELOAD PERMANENT}	{gleiche Attribute wie Unit SYSTEM}
interface
uses WinProcs,WinTypes,ShellAPI;

{MessageBox-Funktionen auf Basis von unterteilten Ressourcen-Strings}
const
 StdMBoxTitle: PChar = nil;
 StdMBoxStyle: Word = MB_OK or MB_IconExclamation;
 StdProfile: PChar = nil;	{Vorgabe: WIN.INI}
 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;
procedure StrDisposeNoDS(var SP: PChar);
function lStrChr(Str:PChar; C:Char):PChar;
function GetPrfXX(Section,Key:PChar; var P; Size:Word):Boolean;
function SetPrfXX(Section,Key:PChar; const P; T:PChar):Boolean;
function GetWndXX(Wnd:HWnd; var P; Size:Word):Boolean;
function GetDlgItemXX(Wnd:HWnd; ID:Word; var P; Size:Word):Boolean;
function GetModuleDescription(FName,Descript:PChar):Boolean;
{extrahiert aus Windows-EXE Modulbeschreibung, max. 255 Zeichen, ANSI-Font
 FName kann auch ein Dateihandle einer offenen Datei sein}
procedure memmove(d,s:Pointer; l:Word);	{prüft auf Überlappung, rep movsb}
const
 GX_PChar	=$0000;
 GX_Int		=$FFF9;
 GX_Word	=$FFF8;
 GX_Long	=$FFFB;
 OFN_LongNames	=$200000;

{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 RegSetVal(Key:HKey;Path,Value:PChar):Boolean;
function RegGetVal(Key:HKey;Path,Value:PChar; VL:Word):Boolean;
function WriteProfileInt(Section,Key:PChar; Value:Integer):Bool;

{Dateifunktionen}
procedure AnsiDosFunc;
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}

procedure TransparentBlt(DC:HDC; x,y:Integer; HBM:HBitmap; cr:TColorRef);
const
 Drive_CDROM	=5;
 Drive_RAM	=6;
function GetDriveTypeEx(Drv:Integer):Word;

{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;
 PtrRec=record
  Ofs,Sel:Word;
 end;
 WordRec=record
  Lo,Hi:Byte;
 end;

 PDropFileStruct=^TDropFileStruct;
 TDropFileStruct=record
  wSize: Word;
  MPos: TPoint;
  InNcArea: Bool;
  FNames: array[0..1] of Char;
 end;
function GetDragClientFromPos(const P:TPoint):HWnd;
function PerformDrop(ToWnd:HWnd;argc:Integer;const argv:PChar):Bool;

{Arbeit mit "Huge"-Zeigern auf Speicher mit mehr als 64 KB}
procedure IncHP(var P:PChar; By: Word);
procedure DecHP(var P:PChar; By: Word);
procedure IncHPL(var P:PChar; By: LongInt);

{Minimum und Maximum, vzb. und vzl.}
function min(I1,I2:Integer):Integer;
 inline($58/$5A/$39/$D0/$7C/$01/$92);
	{pop ax; pop dx; cmp ax,dx; jl $+3; xchg dx,ax}
function minW(W1,W2:Word):Word;
 inline($58/$5A/$39/$D0/$72/$01/$92);
	{pop ax; pop dx; cmp ax,dx; jb $+3; xchg dx,ax}
function max(I1,I2:Integer):Integer;
 inline($58/$5A/$39/$D0/$7F/$01/$92);
	{pop ax; pop dx; cmp ax,dx; jg $+3; xchg dx,ax}
function maxW(W1,W2:Word):Word;
 inline($58/$5A/$39/$D0/$77/$01/$92);
	{pop ax; pop dx; cmp ax,dx; ja $+3; xchg dx,ax}
function Parity(W:Word):Boolean;
 inline($58/$09/$C0/$B0/$00/$7B/$02/$B0/$01);
	{pop ax; or ax,ax; mov al,0; jpo $+4; mov al,1}
function LongMul(A,B:Integer):LongInt;
 inline($5A/$58/$F7/$EA);
	{pop dx; pop ax; imul dx}
function LongMulW(A,B:Word):LongInt;
 inline($5A/$58/$F7/$E2);
	{pop dx; pop ax; mul dx}
function LongDiv(A:LongInt;B:Integer):Integer;
 inline($5B/$58/$5A/$F7/$FB);
	{pop bx; pop ax; pop dx; idiv bx - rundet nicht}
function LongDivR(A:LongInt;B:Integer):LongInt;
 inline($5B/$58/$5A/$F7/$FB);
	{pop bx; pop ax; pop dx; idiv bx - mit Restrückgabe im High-Teil}
function LongDivW(A:LongInt;B:Word):Word;
 inline($5B/$58/$5A/$F7/$F3);
	{pop bx; pop ax; pop dx; div bx - rundet nicht}
function LongDivWR(A:LongInt;B:Word):LongInt;
 inline($5B/$58/$5A/$F7/$F3);
	{pop bx; pop ax; pop dx; div bx - mit Restrückgabe im High-Teil}
function MulDivW(A,B,C:Word):Word;
 inline($5B/$58/$5A/$F7/$E2/$F7/$F3);
	{pop bx; pop ax; pop dx; mul dx; div bx - rundet nicht}
procedure SortRect(var R:TRect);
	{sortiert die Koordinaten in R so um,
	 daß top/left links oben und bottom/right rechts unten ist}
function FirstWord(var S:PChar;Delim:Word):PChar;
	{Abspalten des ersten Wortes von Zeichenkette SP
	 LoByte(Delim) enthält Trennzeichen, HighByte div. Flags}
const
 FW_TrimLeft	=$0100;
 FW_TrimRight	=$0200;
 FW_DblQuote	=$0400;
 FW_SglQuote	=$0800;
 FW_CRLFisWS	=$4000;
 FW_NeverNIL	=$8000;
 FW_CmdLine	=Ord(' ') or FW_TrimLeft or FW_DblQuote;
 FW_Path	=Ord(';') or FW_DblQuote;

{Nützliche Funktionen der Windows-API}
procedure __AHShift;
procedure __AHIncr;
procedure __0000H;
procedure __0040H;
procedure __A000H;
procedure __B000H;
procedure __B800H;
procedure __C000H;
procedure __D000H;
procedure __E000H;
procedure __F000H;
procedure __RomBios;
procedure __WinFlags;
function _hread(f:HFile;Buf:PChar;BufLen:LongInt):LongInt;
function _hwrite(f:HFile;Buf:PChar;BufLen:LongInt):LongInt;
function _LocalLock(Mem: THandle): Word;
function LocalLock(Mem: THandle): Pointer;	{wegen Segmentdefinition!}
function SendMessageWW(Wnd: HWnd; Msg, wParam, lParHi, lParLo: Word): LongInt;
function SendMessageP(Wnd: HWnd; Msg, wParam: Word; lParam: Pointer): LongInt;
function SendDlgItemMsgWW(Dlg: HWnd; IDDlgItem: Integer; Msg, wParam,
  lParHi, lParLo: Word): LongInt;
function SendDlgItemMsgP(Dlg: HWnd; IDDlgItem: Integer; Msg, wParam: Word;
  lParam: Pointer): LongInt;
{Korrekturen fehlerhaft implementierter API-Funktionen}
procedure CopyRect(var DestRect: TRect; const SourceRect: TRect);
function CreatePolygonRgn(const Points; Count, PolyFillMode: Integer): HRgn;
function CreatePolyPolygonRgn(const Points; const PolyCounts; Count,
  PolyFillMode: Integer): HRgn;
function CreateRectRgnIndirect(const Rect: TRect): HRgn;
function EqualRect(const Rect1, Rect2: TRect): Bool;
function FillRect(DC: HDC; const Rect: TRect; Brush: HBrush): Integer;
procedure FrameRect(DC: HDC; const Rect: TRect; Brush: HBrush);
function IntersectRect(var DestRect: TRect; const Src1Rect, Src2Rect: TRect): Integer;
procedure InvertRect(DC: HDC; const Rect: TRect);
function IsRectEmpty(const Rect: TRect): Bool;
function Polygon(DC: HDC; const Points; Count: Integer): Bool;
function Polyline(DC: HDC; const Points; Count: Integer): Bool;
function PolyPolygon(DC: HDC; const Points; const PolyCounts;
  Count: Integer): Bool;
function PtInRect(const Rect: TRect; Point: TPoint): Bool;
function RectInRegion(Rgn: HRgn; const Rect: TRect): Bool;
function RectVisible(DC: HDC; const Rect: TRect): Bool;
function RegisterClass(const WndClass: TWndClass): Bool;
function ScrollDC(DC: HDC; dx, dy: Integer; const Scroll, Clip: TRect;
  UpdateRgn: HRgn; UpdateRect: PRect): Bool;
function SetDIBits(DC: HDC; Bitmap: THandle; StartScan, NumScans: Word;
  Bits: Pointer; const BitsInfo: TBitmapInfo; Usage: Word): Integer;
function SetDIBitsToDevice(DC: HDC; DestX, DestY, Width, Height, SrcX, SrcY,
  nStartScan, NumScans: Word; Bits: Pointer; const BitsInfo: TBitmapInfo;
  Usage: Word): Integer;
procedure SetSysColors(Changes: Integer; const SysColor; const ColorValues);
function StretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHegiht, SrcX,
  SrcY, SrcWidth, SrcHeight: Word; Bits: Pointer; const BitsInfo: TBitmapInfo;
  Usage: Word; Rop: LongInt): Integer;
function TabbedTextOut(HC: HDC; X, Y: Integer; Str: PChar; Count: Integer;
  TabPositions: Integer; const TabStopPositions; TabOrigin: Integer): LongInt;
procedure Throw(const CatchBuf: TCatchBuf; ThrowBack: Integer);
function UnionRect(var DestRect: TRect; const Src1Rect, Src2Rect: TRect):
  Integer;
function wvsprintf(DestStr, Format: PChar; const ArgList): Integer;
function waveInClose(hWaveIn: Word): Word;	{Bösartiger Bug!!}
{Umdefinition des Rückgabewertes}
function GetProfileInt(Sec,Key:PChar; Def: Integer): Integer;
function GetPrivateProfileInt(Sec,Key:PChar; Def: Integer; FileName: PChar):
  Integer;
function MMTaskCreate(Proc:TFarProc; var Task: THandle; Data:LongInt):Integer;
{liefert womöglich Fehlercode, 0 wenn OK}
function MMTaskBlock: Word;
function MMTaskSignal: Bool;
function MMGetCurrentTask: THandle;
function MMTaskYield: Word;

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;
 begin	{** OK für DLL **}
  RegSetRoot:=(RegSetValue(HKCR,Path,REG_SZ,Value,
    lstrlen(Value))=ERROR_SUCCESS);
 end;

function RegGetRoot(Path,Value:PChar; VL:Word):Boolean;
 var	{** OK für DLL **}
  cb: LongInt;
 begin
  cb:=VL;
  RegGetRoot:=(RegQueryValue(HKCR,Path,Value,cb)=ERROR_SUCCESS);
 end;

function RegSetVal(Key:HKey;Path,Value:PChar):Boolean;
 begin	{** OK für DLL **}
  RegSetVal:=(RegSetValue(Key,Path,REG_SZ,Value,
    lstrlen(Value))=ERROR_SUCCESS);
 end;

function RegGetVal(Key:HKey;Path,Value:PChar; VL:Word):Boolean;
 var	{** OK für DLL **}
  cb: LongInt;
 begin
  cb:=VL;
  RegGetVal:=(RegQueryValue(Key,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);
  WriteProfileInt:=WriteProfileString(Section,Key,S);
 end;

function _ldelete(S: PChar):Integer;
{** OK für DLL, nur kurze Dateinamen! **}
 var
  ReOpenBuf: TOfStruct;
 begin
  _lDelete:=OpenFile(S,ReOpenBuf,OF_Delete);
 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
   - "mov ds,seg @data"
   - "export" ist sinnlos, es genügt "far"; dann muß DS gerettet werden
 * Multiple-Instance-Application
   - 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 lStrChr(Str:PChar; C:Char):PChar; assembler;
 asm	les	ax,[Str]
	mov	dx,es
	or	dx,dx
	jz	@@n
	jmp	@@f
@@l:	push	dx
	push	ax
	call	AnsiNext
@@f:	mov	bx,ax
	mov	bl,es:[bx]
	cmp	bl,[C]
	je	@@e
	or	bl,bl
	jnz	@@l
@@n:	xor	ax,ax
	cwd
@@e: 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 AnsiDosFunc; assembler;
{PE: DS:DX=Dateiname (wird ANSI2OEM-konvertiert mit dynamischer
 Stackanforderung); sonstige Register außer BP werden durchgereicht
 VR: DS,DX, weitere Register je nach DOS-Funktion}
 asm	push	bp
	mov	bp,sp
	{Register retten; Windows-Funktionen retten SI und DI selbst}
	push	ax
	push	bx
	push	cx
	push	es
	{Länge ermitteln und Stack reservieren}
	push	dx		{DX über's lstrlen hinüberretten}
	push	ds
	push	dx
	call	lstrlen		{Namenslänge in AX}
	pop	dx
	inc	ax
	inc	ax
	and	al,not 1	{aufrunden und ausrichten}
	sub	sp,ax		{dynamische Stack-Anforderung!!}
	mov	ax,sp		{neuer Stringzeiger}
	{String dahinein kopieren}
	push	ds
	push	dx		{ds:dx=Quelle}
	push	ss
	push	ax		{ss:ax=Ziel}
	call	AnsiToOem
	{Register holen}
	mov	ax,[bp-2]
	mov	bx,[bp-4]
	mov	cx,[bp-6]
	mov	es,[bp-8]
	{DOS rufen}
	push	ss
	pop	ds
	mov	dx,sp		{ds:dx=konvertierter String}
	stc
	call	Dos3Call
	{fertig}
	leave			{sp:=bp, pop bp}
 end;

procedure SortRect(var R:TRect); assembler;
{sortiert die Punkte, daß die Zuordnungen stimmen}
 asm	les	bx,[R]
	mov	ax,es:TRect[bx].left
	cmp	ax,es:TRect[bx].right
	jl	@@1
	xchg	es:TRect[bx].right,ax
	mov	es:TRect[bx].left,ax
@@1:	mov	ax,es:TRect[bx].top
	cmp	ax,es:TRect[bx].bottom
	jl	@@2
	xchg	es:TRect[bx].bottom,ax
	mov	es:TRect[bx].top,ax
@@2:	end;


procedure __AHShift;		external 'KERNEL' index 113;
procedure __AHIncr;		external 'KERNEL' index 114;
procedure __0000H;		external 'KERNEL' index 183;
procedure __0040H;		external 'KERNEL' index 193;
procedure __A000H;		external 'KERNEL' index 174;
procedure __B000H;		external 'KERNEL' index 181;
procedure __B800H;		external 'KERNEL' index 182;
procedure __C000H;		external 'KERNEL' index 195;
procedure __D000H;		external 'KERNEL' index 179;
procedure __E000H;		external 'KERNEL' index 190;
procedure __F000H;		external 'KERNEL' index 194;
procedure __RomBios;		external 'KERNEL' index 173;
procedure __WinFlags;		external 'KERNEL' index 178;
function _hread;		external 'KERNEL' index 349;
function _hwrite;		external 'KERNEL' index 350;
procedure Throw;		external 'KERNEL' index 56;
function GetProfileInt;		external 'KERNEL' index 57;
function GetPrivateProfileInt;	external 'KERNEL' index 127;
function _LocalLock;		external 'KERNEL' index 8;
function SendMessageWW;		external 'USER' index 111;
function SendMessageP;		external 'USER' index 111;
function SendDlgItemMsgWW;	external 'USER' index 101;
function SendDlgItemMsgP;	external 'USER' index 101;
procedure CopyRect;		external 'USER' index 74;
function IsRectEmpty;		external 'USER' index 75;
function PtInRect;		external 'USER' index 76;
function IntersectRect;		external 'USER' index 79;
function UnionRect;		external 'USER' index 80;
function FillRect;		external 'USER' index 81;
procedure InvertRect;		external 'USER' index 82;
procedure FrameRect;		external 'USER' index 83;
function EqualRect;		external 'USER' index 244;
function RegisterClass;		external 'USER' index 57;
function ScrollDC;		external 'USER' index 221;
procedure SetSysColors;		external 'USER' index 181;
function TabbedTextOut;		external 'USER' index 196;
function wvsprintf;		external 'USER' index 421;
function CreatePolygonRgn;	external 'GDI' index 63;
function CreatePolyPolygonRgn;	external 'GDI' index 451;
function CreateRectRgnIndirect;	external 'GDI' index 65;
function Polygon;		external 'GDI' index 36;
function Polyline;		external 'GDI' index 37;
function PolyPolygon;		external 'GDI' index 450;
function RectInRegion;		external 'GDI' index 181;
function RectVisible;		external 'GDI' index 104;
function SetDIBits;		external 'GDI' index 440;
function SetDIBitsToDevice;	external 'GDI' index 443;
function StretchDIBits;		external 'GDI' index 439;
function waveInClose;		external 'MMSYSTEM' index 505;
function MMTaskCreate;		external 'MMSYSTEM' index 900;
function MMTaskBlock;		external 'MMSYSTEM' index 902;
function MMTaskSignal;		external 'MMSYSTEM' index 903;
function MMGetCurrentTask;	external 'MMSYSTEM' index 904;
function MMTaskYield;		external 'MMSYSTEM' index 905;

function LocalLock(Mem: THandle): Pointer; assembler;
asm	push	Mem
	call	_LocalLock
	mov	dx,ds
end;
function GetDragClientFromPos(const P:TPoint):HWnd;
 var
  Wnd:HWnd;
 begin
  Wnd:=WindowFromPoint(P);
  if Wnd<>0 then begin
   if GetWindowLong(Wnd,GWL_ExStyle) and WS_EX_AcceptFiles =0
   then Wnd:=0;
  end;
  GetDragClientFromPos:=Wnd;
 end;

function PerformDrop(ToWnd:HWnd;argc:Integer;const argv:PChar):Bool;
{enthält Bugs!!}
 var
  HDrop: THandle;
  dfsp: PDropFileStruct;
  len: Word;
  i: Integer;
  ppc: ^PChar;
  SP: PChar absolute dfsp;
 begin
  if ToWnd=0 then exit;
  if argc<=0 then exit;
  ppc:=@argv;
  len:=sizeof(dfsp)-1;
  for i:=1 to argc do begin
   if ppc^=nil then exit;
   Inc(len,lstrlen(ppc^)+1);	{Gesamtlänge ermittlen}
   Inc(ppc);
  end;
  HDrop:=GlobalAlloc(GMEM_Share or GMEM_Moveable, len);
  dfsp:=GlobalLock(HDrop);
  dfsp^.wSize:=8;
  dfsp^.InNcArea:=Bool(SendMessage(ToWnd,WM_NcHitTest,0,LongInt(dfsp^.mPos))
    <>HTClient);
  ScreenToClient(ToWnd,dfsp^.mPos);
  ppc:=@argv;
  SP:=dfsp^.fNames;
  for i:=1 to argc do begin
   lstrcpy(SP,ppc^);
   Inc(SP,lstrlen(ppc^));
   SP^:=#0;
   Inc(SP);
   Inc(ppc);
  end;
  SP^:=#0;
  GlobalUnlock(HDrop);
  PostMessage(ToWnd,WM_DropFiles,HDrop,0);
 end;

{IncHugePointer - Erhöhen eines Zeigers
 auf Speicher mit mehr als 64 Kilobyte; Windows-Version mit AHIncr}
procedure IncHP(var P:PChar; By: Word); assembler;
 asm
  les di,[P]			{Adresse von P}
  mov ax,[By]
  add es:PtrRec[di].Ofs,ax	{Offset inkrementieren}
  jnc @@e			{kein Überlauf: Selektor belassen!}
  add es:PtrRec[di].Sel,offset __AHIncr	{Selektor erhöhen}
@@e:
 end;

{DecHugePointer - Erniedrigen eines Zeigers
 auf Speicher mit mehr als 64 Kilobyte; Windows-Version mit AHIncr}
procedure DecHP(var P:PChar; By: Word); assembler;
 asm
  les di,[P]			{Adresse von P}
  mov ax,[By]
  sub es:PtrRec[di].Ofs,ax	{Offset inkrementieren}
  jnc @@e			{kein Überlauf: Selektor belassen!}
  sub es:PtrRec[di].Sel,offset __AHIncr	{Selektor erniedrigen}
@@e:
 end;

{IncHugePointerLong - Erhöhen und Erniedrigen eines Zeigers
 auf Speicher mit mehr als 64 Kilobyte; Windows-Version mit AHIncr}
procedure IncHPL(var P:PChar; By: LongInt); assembler;
 asm
  les di,[P]			{Adresse von P}
  mov cx,LongRec[By].Lo		{Hier AX:CX: ungewöhnlich!}
  mov ax,LongRec[By].Hi
  add es:PtrRec[di].Ofs,cx	{Offset inkrementieren}
  adc ax,0			{Anzahl der 64-K-Übergänge}
  mov cx,offset __AHShift
  shl ax,cl			{Vielfaches erzeugen}
  add es:PtrRec[di].Sel,ax	{Selektor erhöhen bzw. erniedrigen}
 end;

{TransparentBlt: von der MSDN-Library-CD
 kopiert Bitmap unter Angabe einer tranparenten Farbe (TColorRef)
 in einen Zielkontext. Dreh- und Angelpunkt ist der korrekte ROP.
 PE: DC:  Zielgerätekontext
     x,y: Ziel-Koordinaten linke obere Ecke
     hBm: Quell-Bitmap
     cr:  Transparente Farbe}
procedure TransparentBlt(DC:HDC; x,y:Integer; HBM:HBitmap; cr:TColorRef);
 const ROP_DSPDxax=$00E20746;
 var
  hDCSrc,hDCMid: HDC;
  hBmpMono: HBitmap;
{  hBrT: HBrush;}
  crBack,crText: TColorRef;
  bm: TBitmap;
 begin
  if HBM<>0 then begin
   GetObject(hBM,sizeof(bm),@bm);
   hDCSrc:=CreateCompatibleDC(DC);
   hDCMid:=CreateCompatibleDC(DC);
   hBmpMono:=CreateCompatibleBitmap(hDCMid,bm.bmWidth,bm.bmHeight);
   SelectObject(hDCSrc,hBm);
   SelectObject(hDCMid,hBmpMono);

   crBack:=SetBkColor(hDCSrc,cr);
   BitBlt(hDCMid,0,0,bm.bmWidth,bm.bmHeight,hDCSrc,0,0,SrcCopy);
   SetBkColor(hDCSrc,crBack);

   BitBlt(DC,x,y,bm.bmWidth,bm.bmHeight,hDCSrc,0,0,SrcCopy);
{   hBrT:=SelectObject(DC,CreateSolidBrush(GetBkColor(DC)));}
   crText:=SetTextColor(DC,$000000);
   crBack:=SetBkColor(DC,$FFFFFF);
   BitBlt(DC,x,y,bm.bmWidth,bm.bmHeight,hDCMid,0,0,ROP_DSPDxax);
   SetTextColor(DC,crText);
   SetBkColor(DC,crBack);
{   DeleteObject(SelectObject(DC,hBrT));}
   DeleteDC(hDCSrc);
   DeleteDC(hDCMid);
   DeleteObject(hBmpMono);
  end;
 end;

{GetDriveTypeEx: Laufwerkstyp ermitteln, mit CD-ROM und RAM
 PE: Drv:	Nullbasierter Laufwerks-Index
 PA: Einer der Werte:
   Drive_Removable, Drive_Fixed, Drive_Remote, Drive_CDROM, Drive_RAM}

function GetDriveTypeEx(Drv:Integer):Word; assembler;
 asm
	push	[Drv]
	call	GetDriveType
	cmp	ax,Drive_Fixed
	jz	@@TestCD
	cmp	ax,Drive_Remote
	jnz	@@SkipCD
@@TestCD:
	push	ax
	 mov	ax,$1500
	 xor	bx,bx
	 int	$2f	{Test MSCDEX-Präsenz}
	 or	bx,bx
	 jz	@@NoCD
	 mov	ax,$150B
	 mov	cx,[Drv]
	 int	$2f	{Test Laufwerk=CD-ROM?}
	 or	ax,ax
	 jz	@@NoCD
	pop	ax
	push	Drive_CDROM
@@NoCD:
@@SkipCD:
	pop	ax
	cmp	ax,Drive_Fixed
	jnz	@@SkipRAM
	push	ax
	push	ds
	 push	ss
	 pop	ds
	 sub	sp,$200	{Dynamische Stackreservierung zum Sektorlesen}
	 mov	bx,sp	{BX=Sektorzeiger}
	 mov	ax,[Drv]
	 mov	cx,1	{Anzahl=1}
	 xor	dx,dx	{Sektor 0}
	 int	$25
	 jc	@@NoRAM
	 mov	bx,sp	{Achtung: BX ist 2 tiefergelegt!}
	 cmp	byte ptr ss:[bx+$17],$f8 {Nochmals auf "Festplatte" testen}
	 jne	@@NoRAM
	 cmp	byte ptr ss:[bx+$12],1	{Eine FAT?}
	 jne	@@NoRAM
	 mov	word ptr ss:[bx+$204],Drive_RAM	{gepushtes AX verändern!!}
@@NoRAM:
	 add	sp,$202	{Stack freigeben, 2 mehr wegen Int25}
	pop	ds
	pop	ax
@@SkipRAM:
 end;

function FirstWord(var S:PChar;Delim:Word):PChar; assembler;
{TOTAL FEHLERHAFT!}
 var
  StartPos,EndPos:Word;
  TermChar:Char;
  InQuote:Boolean;
 asm	push	ds
	 les	di,S
	 mov	cx,[Delim]
	 mov	[TermChar],cl	{Zunächst Endezeichen}
	 mov	[InQuote],0
	 lds	si,es:[di]
	 cld
@@tl:	 mov	[StartPos],si	{Startposition im Stack merken}
	 lodsb
	 cmp	al,0
	 jz	@@end
	 cmp	al,' '
	 jz	@@lspc
	 cmp	al,9
	 jz	@@lspc
	 cmp	al,10
	 jz	@@lspc0
	 cmp	al,13
	 jz	@@lspc0
	 cmp	al,'"'
	 jz	@@DQ
	 cmp	al,''''
	 jz	@@SQ
{Sonstiger Buchstabe}
@@l:
	 push	ax
	 call	IsDBCSLeadByte
	 add	ax,-1	{0-->CY=0}
	 adc	si,0	{sprungfrei bedingt inkrementieren}
	 lodsb
	 cmp	al,0
	 jz	@@end
	 cmp	al,[TermChar]
	 jz	@@term
	 cmp	al,' '
	 jz	@@rspc
	 cmp	al,9
	 jz	@@rspc
	 cmp	al,10
	 jz	@@rspc0
	 cmp	al,13
	 jz	@@rspc0


@@te:
	 mov	dx,ds
	 mov	ax,[StartPos]
	pop	ds
	jmp	@@e
@@lspc0: test	ch,$40	{Zeilenendezeichen erlaubt?}
	 jz	@@l	{nein}
@@lspc:	 test	ch,1	{TrimLeft}
	 jz	@@l	{nein, als Buchstabe auffassen}
	 jmp	@@tl	{ja, weiter in TrimLeft}
@@DQ:	 test	ch,4
	 jz	@@l	{nein, als Buchstabe auffassen}
	 mov	[TermChar],'"'
	 jmp	@@l0
@@SQ:	 test	ch,8
	 jz	@@l
	 mov	[TermChar],''''
@@l0:	 mov	[StartPos],si	{Start ist HINTER dem Qu(ix)ote}
	 or	[InQuote],1
	 jmp	@@l
@@term:	 test	[InQuote],1
	 jnz	@@t1
	 lea	bx,[si-1]
	 mov	byte ptr [bx],0
	 mov	es:[di],bx
	 jmp	@@te
@@rspc0:
@@rspc:
@@t1:
@@end:

@@e: end;

procedure StrDisposeNoDS(var SP:PChar);
 begin
  if Seg(SP^)<>Seg(HInstance) then StrDispose(SP);
  SP:=nil;
 end;

function Str2XX(S:PChar; var P; Size:Word):Boolean;
 var
  HL: LongInt;
  EC: Integer;
 begin
  Str2XX:=false;
  case Size of
   GX_Long: begin
    Val(S,HL,EC);  {VAL setzt bei Fehler Ziel auf 0, daher Hilfsvariable}
    if EC=0 then begin
     LongInt(P):=HL;
     Str2XX:=true;
    end;
   end;
  end;
 end;

{Kapselfunktionen, die je nach StdProfile die WIN.INI oder eine private
 .INI modifizieren. Zugriff auf die WIN.INI mit xxxPrivatexxx ist
 gefährlich, da USER.EXE die WIN.INI dann 2x im Cache hält...}

function GetPrfInt(Sec,Key:PChar; Def:Integer):Integer; near; assembler;
 asm	pop bp			{Pascal-Ärger!}
	pop si			{Returnadresse}
	les di,[StdProfile]
	mov cx,es
	jcxz @@winini
	push es; push di
	call GetPrivateProfileInt
	jmp si
@@winini:
	call GetProfileInt
	jmp si
 end;

function GetPrfString(Sec,Key,Def,S:PChar;size:Integer):Integer; near;
  assembler;
 asm	pop bp			{Pascal-Ärger!}
	pop si			{Returnadresse}
	les di,[StdProfile]
	mov cx,es
	jcxz @@winini
	push es; push di
	call GetPrivateProfileString
	jmp si
@@winini:
	call GetProfileString
	jmp si
 end;

function WritePrfString(Sec,Key,S:PChar):Bool; near; assembler;
 asm	pop bp			{Pascal-Ärger!}
	pop si			{Returnadresse}
	les di,[StdProfile]
	mov cx,es
	jcxz @@winini
	push es; push di
	call WritePrivateProfileString
	jmp si
@@winini:
	call WriteProfileString
	jmp si
 end;

function GetPrfXX(Section,Key:PChar; var P; Size:Word):Boolean;
 var
  S: array[0..1023] of Char;	{ich glaube, GetXXString liefert nicht mehr}
 begin
  GetPrfXX:=false;
  case Size of
   GX_Int,GX_Word: begin
    Integer(P):=GetPrfInt(Section,Key,Integer(P));
    GetPrfXX:=true;
   end;
   0: begin
    GetPrfString(Section,Key,PChar(P),S,sizeof(S));
    if (PChar(P)=nil) or (lstrcmp(PChar(P),S)<>0) then begin
     StrDisposeNoDS(PChar(P));
     PChar(P):=StrNew(S);		{schöne Schaufelei!}
    end;
    GetPrfXX:=true;
   end;
   2..$EFFF: begin
    GetPrfString(Section,Key,PChar(@P),PChar(@P),Size);
    GetPrfXX:=true;
   end;
   else begin
    GetPrfString(Section,Key,'',S,sizeof(S));
    GetPrfXX:=Str2XX(S,P,Size);
   end;
  end;
 end;

function SetPrfXX(Section,Key:PChar; const P; T:PChar):Boolean;
 var
  S: array[0..1023] of Char;
 begin
  if T<>nil then begin
   wvsprintf(S,T,P);
   WritePrfString(Section,Key,S);
  end else begin
   WritePrfString(Section,Key,PChar(@P));
  end;
 end;

function GetWndXX(Wnd:HWnd; var P; Size:Word):Boolean;
 var
  W: Word;
  S: array[0..255]of Char;
 begin
  GetWndXX:=true;
  case Size of
   0: begin
    StrDisposeNoDS(PChar(P));
    W:=Word(GetWindowTextLength(Wnd))+1;
    GetMem(PChar(P),W);
    GetWindowText(Wnd,PChar(P),W);
   end;
   2..$EFFF: begin
    GetWindowText(Wnd,PChar(@P),Size);
   end;
   else begin
    GetWindowText(Wnd,S,sizeof(S));
    GetWndXX:=Str2XX(S,P,Size);
   end;
  end;
 end;

function GetDlgItemXX(Wnd:HWnd; ID:Word; var P; Size:Word):Boolean;
 var
  B: Bool;
  W: Word;
 begin
  case Size of
   GX_Int: begin
    Integer(W):=GetDlgItemInt(Wnd,ID,@B,true);
    if B then Integer(P):=Integer(W);
    GetDlgItemXX:=B;
   end;
   GX_Word: begin
    W:=GetDlgItemInt(Wnd,ID,@B,true);
    if B then Word(P):=W;
    GetDlgItemXX:=B;
   end;
   else begin
    GetDlgItemXX:=GetWndXX(GetDlgItem(Wnd,ID),P,Size);
   end;
  end;
 end;

function GetModuleDescription(FName,Descript:PChar):Boolean;
{extrahiert aus Windows-EXE Modulbeschreibung, max. 255 Zeichen, ANSI-Font}
 const
  MZ=$5A4D;
  NE=$454E;
 label
  finally;
 var
  f: Integer absolute FName;
  L: LongInt;
  LR: LongRec absolute L;
  W: Word absolute L;
  B: Byte absolute L;
 begin
  GetModuleDescription:=false;
  if PtrRec(FName).Sel<>0
  then f:=_lopen(FName,0);	{Share-Modus richtig?}
  if f=0 then exit;		{falls NIL übergeben wurde}
  if f=-1 then exit;		{falls das Öffnen fehlschlug}
  _lread(f,PChar(@W),2);
  if W<>MZ then goto finally;
  _llseek(f,$18,0);
  _lread(f,PChar(@W),2);
  if W<>$0040 then goto finally;
  _llseek(f,$3C,0);
  _lread(f,PChar(@L),4);	{neuer Dateioffset}
  _llseek(f,L,0);
  if _lread(f,PChar(@W),2)<>2 then goto finally;
  if W<>NE then goto finally;
  _llseek(f,$2A,1);		{42 Bytes hinter NE}
  _lread(f,PChar(@L),4);	{Dateioffset des Pascal-Strings}
  _llseek(f,L,0);
  if _lread(f,PChar(@B),1)<>1 then goto finally;
  if B=0 then goto finally;
  W:=B;
  if _lread(f,Descript,W)<>W then goto finally;
  for LR.Hi:=0 to W-1 do if Descript[LR.Hi]<' ' then goto finally;
  Descript[W]:=#0;		{terminieren}
  OemToAnsi(Descript,Descript);
  GetModuleDescription:=true;
finally:
  if PtrRec(FName).Sel<>0
  then _lclose(f);
 end;

procedure memmove(d,s:Pointer; l:Word); assembler;
 asm	cld
	push	ds
	 lds	si,[s]
	 les	di,[d]
	 mov	cx,[l]
	 cmp	si,di
	 jnc	@@up
	 dec	cx
	 add	si,cx
	 add	di,cx
	 inc	cx
	 std
@@up:	 rep	movsb
	pop	ds
	cld
 end;

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;

Vorgefundene Kodierung: OEM (CP437)1
Umlaute falsch? - Datei sei ANSI-kodiert (CP1252)