{$A+,B-,D+,F-,G+,I-,K+,L+,N-,P-,Q-,R-,S-,T-,V+,W-,X+,Y+}
{$M 8192,0}
program dknack; {Dongle-Knacker}
uses WinProcs, WinTypes, VDongle, CommDlg, ShellApi, Win31, {WinMem32,}
WinDos, ToolHelp, Strings, WUtils,LZExpand;
{$R dknack}
{$D DongleKnacker 1.05c (07/97)}
const
AppName: array[0..13]of Char='DongleKnacker';
{Vorgabe, überschrieben per Kommandozeilenschalter "-title"}
HelpFileName: array[0..10]of Char='DKNACK.HLP';
HdrSign=$4B44; {"DK"}
MaxBuffer=2047; {maximal 32000}
MaxTable=4000000; {maximal 16 Millionen Bytes}
const
PlayMode: Bool=false; {Wiedergabe-Betriebsart?}
Named: Boolean=false; {Datei bereits benannt oder nicht}
Dirty: Boolean=false; {Datei muß aktualisiert werden oder nicht}
WarnIfDirty: Bool=false;
CurrentCompress: Integer=0; {Kompressionsmethode: Nicht packen}
const
WM_DongleAccess=WM_User+10;
WM_ContinueInit=WM_User+11;
type
PBuffer=^TBuffer;
TBuffer=array[0..MaxBuffer] of Word; {Transfer-Puffer}
PTable=^TTable;
TTable=array[0..0] of PBuffer; {viele dynamische Puffer}
var
BufSel: Word; {ein statischer Puffer im VxD, Offset ist 0}
TableHandle: THandle; {mit Huge-GlobalAlloc angeforderter Speicher}
TableIdx,TableEnd: LongInt;
TableSize: LongInt; {Größe des WinMem32-Blocks in Bytes}
var
VDongleVer: Word;
function GetExePath(S: PChar):PChar; {liefert STREND(S)}
begin
GetArgStr(S,0,256); {Aktueller Pfad zur EXE}
GetExePath:=GetFileNamePtr(S);
end;
function AddVxDToSystemIni:Boolean;
{Annahme: VDONGLE.386 befindet sich im gleichen Verzeichnis wie die
gerade laufende .EXE. Die Einfügung erfolgt direkt am Beginn der
[386Enh]-Sektion. Weitere Zeilen mit "VDONGLE.386" am Ende werden
dabei entfernt zum Vermeiden von "Doppel-Loads".}
var
VxDPath: array[0..255]of Char;
PL: PChar;
begin
AddVxDToSystemIni:=false;
PL:=GetExePath(VxDPath); {Aktueller Pfad zur EXE}
lStrCpy(PL,VxDName); {VxD-Name statt Programm-Name}
{Nun steht in der Variable "VxDPath" der komplette Pfadname zum VxD}
AddVxDToSystemIni:=AddRemoveVxD(VxDPath,VxDName)=0;
end;
function UpdateRegistry:boolean;
var
S:array[0..255]of Char;
begin
RegSetRoot('.DK','DKnack');
RegSetRoot('.DK_','DKnack');
RegSetRoot('.DKZ','DKnack');
RegSetRoot('DKnack',AppName);
GetArgStr(S,0,sizeof(S)); {Programmname samt Pfad ermitteln}
lstrcat(S,' %1'); {Hier kommt dann der Dateiname hin}
RegSetRoot('DKnack\shell\open\command',S);
end;
var
AutoRun: array[0..255]of Char;
FileName: array[0..255]of Char;
OfnFilter: array[0..255]of Char;
function LfnHook(Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Word; export;
var
S: array[0..255] of Char;
I,J,E: Integer;
begin
LfnHook:=0;
case Msg of
WM_InitDialog: begin
LoadString(Seg(HInstance),13{Anhängen},S,sizeof(S));
SetDlgItemText(Wnd,1040,S);
end;
end;
end;
const
Zipper: array[0..127]of Char='pkzip -j';
Unzipper: array[0..127]of Char='pkunzip -o -j';
DOSShowCmd: integer=SW_Hide;
const
ofn: TOpenFileName=(
lStructSize: sizeof(TOpenFileName);
hWndOwner: 0;
hInstance: Seg(HInstance);
lpstrFilter: @OfnFilter;
lpstrCustomFilter: nil;
nMaxCustFilter: 0;
nFilterIndex: 0;
lpstrFile: @FileName;
nMaxFile: sizeof(FileName);
lpstrFileTitle: nil;
nMaxFileTitle: 0;
lpstrInitialDir: nil;
lpstrTitle: nil;
Flags: OFN_FileMustExist or OFN_EnableHook
or OFN_OverWritePrompt or OFN_HideReadOnly;
nFileOffset: 0;
nFileExtension: 0;
lpstrDefExt: 'dk';
lCustData: 0;
lpfnHook: LFNHook;
lpTemplateName: nil);
procedure AllocError;
begin
RunError(203);
end;
var
AccessOutCount: LongInt;
AccessInCount: LongInt;
AccessFails: LongInt;
AccessTimeCount: LongInt;
var
OutNotify, InNotify, TimeNotify: LongInt;
DoubleOuts,Posted: Boolean;
{Variablen für IsConsistent}
procedure InitDkMem; external;
procedure ClearDkMem; external;
procedure DoneDkMem; external;
function TheCallback:Byte; far; external;
procedure NewDkMem(NewSize:LongInt); external;
function IsConsistent:Boolean; external;
{$L dknack}
var
Wnd: HWnd; {Global ist besser im Zugriff!}
procedure SetPlayMode(NewMode:Bool);
begin
if PlayMode<>NewMode then begin
PlayMode:=NewMode;
CheckDlgButton(Wnd,104,Word(PlayMode));
if PtrRec(VDongleEntry).Sel<>0 then
asm
mov al,byte ptr [PlayMode]
mov ah,3 {Emulation setzen/löschen}
call [VDongleEntry]
end;
end;
end;
procedure SetDlgItems(Template:PChar);
var
SS: array[0..13]of Char;
begin
wvsprintf(SS,Template,AccessOutCount);
SetDlgItemText(Wnd,101,SS);
wvsprintf(SS,Template,AccessInCount);
SetDlgItemText(Wnd,102,SS);
wvsprintf(SS,Template,AccessFails);
SetDlgItemText(Wnd,103,SS);
wvsprintf(SS,Template,AccessTimeCount);
SetDlgItemText(Wnd,107,SS);
end;
procedure SetDlgItemBracketLong(ID:Word; L:LongInt);
var
SS: array[0..13]of Char;
begin
wvsprintf(SS,'(%ld)',L);
SetDlgItemText(Wnd,ID,SS);
end;
function AssertNonExclusive:Boolean;
begin
AssertNonExclusive:=false; {pessimistisch}
while GetPrivateProfileInt('386Enh','WinExclusive',0,'SYSTEM.INI')<>0 do
if MBox1(Wnd,28{Exklusiv-Modus},nil)=IDCancel then exit;
AssertNonExclusive:=true;
end;
function OpenZipFile(FileName:PChar; OpenMode:Integer; Wnd:HWnd;
var fh:HFile; var TempFile:PChar):Integer;
{weitere Parameter: Unzip-Fenstertitel, Name oder Nummer der Auspack-Datei..}
{Rückgaben:
0: alles OK, Datei ist unkomprimiert
>0: alles OK, Datei war komprimiert (Nummer=Auspack-Routine EXP/ZIP/ARJ/...)
<0: Fehler beim Öffnen oder Auspacken:
-1: ...beim Öffnen der Ursprungsdatei
-2: ...beim Auswerten der Dateiinformationen
-3: ...beim Kreieren der .PIF-Datei
-4: ...beim Starten des Entpackers
-5: ...beim Öffnen der ausgepackten Datei}
{Mögliches Problem: Codeseiten - es fehlt AnsiToOem() und umgekehrt}
const
ZipSign=$4B50; {"PK"}
ExpSign=$5A53; {"SZ"}
var
f: HFile;
w:Word;
PFile,TFile,CmdLine: array[0..255]of Char;
SP,EFile: PChar;
APif:TPif;
begin
TempFile:=nil;
f:=_lopen(FileName,OpenMode);
OpenZipFile:=-1; {Fehler beim ersten Öffnen}
if f=HFILE_Error then exit;
if _lread(f,PChar(@w),2)=2 then begin;
case w of
ExpSign: begin
GetTempFileName(#0,'DKZ',0,TFile); {Künftiger Ziel-Dateiname}
_llseek(f,0,0); {Quelldatei schon offen}
fh:=_lcreat(TFile,0); {Zieldatei}
if fh=HFILE_Error then exit;
if LZCopy(f,fh)<0 then exit; {Auspacken}
_lclose(f);
OpenZipFile:=1; {Auspacken mit EXPAND OK}
TempFile:=StrNew(TFile);
_llseek(fh,0,0); {"Zurückspulen"}
exit;
end;
ZipSign: begin
OpenZipFile:=-2;
GetTempFileName(#0,'DKZ',0,PFile);
_ldelete(PFile); {Windows ist schon mächtig komisch!}
lStrCpy(GetFileNameExt(PFile),'.PIF');{PIF-Dateiname im TEMP-Vrz.}
EFile:=GetFileNamePtr(PFile); {Dateiname adressieren}
lStrCpy(CmdLine,PFile); {Erstes Element der Kommandozeile}
{Name der ersten Datei extrahieren und an TEMP-Pfad anhängen}
_llseek(f,$1A,0); {_llseek macht niemals Fehler!}
if _lread(f,PChar(@w),2)<>2 then exit;{Name-Länge}
if w>255 then exit; {Notbremse!}
_llseek(f,$1E,0);
if _lread(f,TFile,w)<>w then exit; {Name selbst}
TFile[w]:=#0; {nullterminieren}
_lclose(f); {fertig mit Auslesen}
{Kommandozeile für Unzipper zusammenstellen}
OpenZipFile:=-3;
lStrCat(lStrCat(CmdLine,' /C '),Unzipper);
SP:=StrEnd(CmdLine);
SP^:=' '; Inc(SP); {trennt Optionen vom .ZIP-File}
SP:=StrEnd(FileExpand(SP,FileName));{ZIP-Pfad+Dateiname+Ext}
SP^:=' '; Inc(SP);
lStrCpy(SP,TFile); {Dateiname aus .ZIP-Datei}
{PIF-Datei kreieren}
SP:=nil;
if ((EFile-1)^='\') then begin
SP:=EFile-1; {Backslash wegpatchen,}
if (SP-1)^<>':' then SP^:=#0; {Pfad benötigt}
end;
CreatePif(MakeIntResource(26),nil,nil,PFile,APif);
if SP<>nil then SP^:='\'; {Backslash wieder zurückpatchen}
f:=_lcreat(PFile,0); {PIF-Datei kreieren}
if f=HFILE_Error then exit;
if _lwrite(f,PChar(@APIF),sizeof(APIF))<>sizeof(APIF) then exit;
_lclose(f);
{Auspacken starten}
OpenZipFile:=-4;
if not AssertNonExclusive then exit;
if ExecAndWait(CmdLine,DOSShowCmd,Wnd)>$4000 then exit;
_ldelete(PFile);
{Ergebnisdatei öffnen und fürs Löschen vorbereiten}
OpenZipFile:=-5;
lStrCpy(EFile,TFile); {Temp-Pfad plus ausgepackte Datei}
f:=_lopen(PFile,OpenMode);
if f=HFILE_Error then exit;
OpenZipFile:=2;
fh:=f;
TempFile:=StrNew(PFile); {auf dem Heap}
exit;
end;
end{case};
end;
_llseek(f,0,0);
fh:=f;
OpenZipFile:=0; {Nicht ausgepackt}
end;
function CloseZipFile(f:HFile; TempFile:PChar):Integer;
begin
CloseZipFile:=_lclose(f);
if TempFile<>nil then begin
_ldelete(TempFile);
StrDispose(TempFile);
end;
end;
type
TCreateZipStruct=record
NormalFile,ArchiveFile: PChar;
ZipNo: Integer;
Wnd: HWnd;
end;
function CreateZipFile(FileName:PChar; ZipNo:Integer; Wnd:HWnd;
var fh:HFile; var CZS:TCreateZipStruct):Integer;
var
f: HFile;
S: array[byte]of Char;
EFile,SP: PChar;
begin
FillChar(CZS,sizeof(CZS),0); {Struktur ausnullen}
f:=_lcreat(FileName,0); {Vorhandene Datei zu Null machen}
if f=HFILE_Error then exit;
if (ZipNo=0) or (ZipNo>2) then begin {Kein Zippen gewünscht oder möglich?}
fh:=f;
exit; {Dann sind wir schon fertig!}
end;
_lclose(f);
_ldelete(FileName); {Löschen}
GetTempFileName(#0,'DKZ',0,S); {Temporären Dateinamen ermitteln}
SP:=GetFileNameExt(FileName);
if (SP^<>#0) and ((SP+1)^<>#0) then begin {Echte Extension vorhanden?}
_ldelete(S);
lStrCpy(GetFileNamePtr(S),GetFileNamePtr(FileName));
(StrEnd(S)-1)^:=#0; {Letzten Buchstaben abhacken}
end;
f:=_lcreat(S,0); {Handle auf temporäre Datei}
if f=HFILE_Error then exit; {Fehler - 'raus!}
fh:=f;
CZS.NormalFile:=StrNew(S);
CZS.ArchiveFile:=StrNew(FileName);
CZS.ZipNo:=ZipNo;
CZS.Wnd:=Wnd;
end;
function CreateZipClose(f:HFile; var CZS:TCreateZipStruct):Integer;
label CleanUp;
var
Compressor,EFile,SP: PChar;
PFile,CmdLine: array[byte]of Char;
SP4: array[0..3]of PChar;
APif:TPif;
begin
CreateZipClose:=-1;
if _lclose(f)=HFILE_Error then goto CleanUp;
if CZS.ZipNo=0 then begin
CreateZipClose:=0;
exit; {nichts zum Einpacken!}
end;
EFile:=GetFileNamePtr(CZS.NormalFile);{Dateiname adressieren (Endung .TMP)}
lStrCpy(PFile,CZS.NormalFile);
lStrCpy(GetFileNameExt(PFile),'.PIF');{Endung zu .PIF machen}
{Kommandozeile für Zipper zusammenstellen}
SP4[0]:=PFile;
case CZS.ZipNo of
1: begin
SP4[1]:='COMPRESS';
SP4[2]:=EFile; {vertauschte Reihenfolge!!}
SP4[3]:=CZS.ArchiveFile;
end;
2: begin
SP4[1]:=Zipper;
SP4[2]:=CZS.ArchiveFile;
SP4[3]:=EFile;
end;
end;
wvsprintf(CmdLine,'%s /C %s %s %s',SP4); {zusammenstellen}
{PIF-Datei kreieren}
CreateZipClose:=-3;
SP:=nil;
if ((EFile-1)^='\') then begin
SP:=EFile-1; {Backslash wegpatchen,}
if (SP-1)^<>':' then SP^:=#0; {Pfad benötigt}
end;
CreatePif(MakeIntResource(27),nil,nil,CZS.NormalFile,APif);
if SP<>nil then SP^:='\'; {Backslash wieder zurückpatchen}
f:=_lcreat(PFile,0); {PIF-Datei kreieren}
if f=HFILE_Error then goto CleanUp;
if _lwrite(f,PChar(@APIF),sizeof(APIF))<>sizeof(APIF) then goto CleanUp;
_lclose(f);
{Einpacken starten}
CreateZipClose:=-4;
if not AssertNonExclusive then goto CleanUp;
if ExecAndWait(CmdLine,DOSShowCmd,CZS.Wnd)>$4000 then goto CleanUp;
_ldelete(PFile);
_ldelete(CZS.NormalFile);
{Ergebnisdatei zur Probe öffnen und 4 Bytes lesen}
CreateZipClose:=-5;
f:=_lopen(CZS.ArchiveFile,0);
if f=HFILE_Error then goto CleanUp;
if _lread(f,PChar(@SP4),4)=4 then CreateZipClose:=0;
_lclose(f);
CleanUp:
StrDispose(CZS.NormalFile);
StrDispose(CZS.ArchiveFile);
end;
procedure CheckOutConcat; assembler;
asm mov ax,$8FF
call [VDongleEntry]
jc @@e {Menüpunkt bleibt grau}
or al,al
mov si,MF_ByCommand or MF_UnChecked
jz @@2
mov si,MF_ByCommand or MF_Checked
@@2: push [Wnd]
call GetMenu
push ax {Menü-Handle für später}
push 16
push si {Check-Status}
push ax
push 16
push MF_ByCommand or MF_Enabled
call EnableMenuItem {Menüpunkt freischalten}
call CheckMenuItem
@@e: end;
function LoadDkFile(FileName:PChar; Append:Bool):Boolean;
{Fehlerauswertung eingebaut!}
{liefert TRUE bei komprimierter Datei}
label
l1,l2;
var
f: HFile;
w: Word; {Hilfsspeicher}
br: Word;
OK: Bool;
OldCurs: HCursor;
ImagLen: LongInt;
SS: array[0..13]of Char;
StartP:Pointer; {Startpunkt im HugeMem-Speicherblock}
TF: PChar;
i: Integer;
begin
LoadDkFile:=false;
OK:=false;
OldCurs:=SetCursor(LoadCursor(0,IDC_Wait));
ShowCursor(true);
i:=OpenZipFile(FileName,OF_Read,Wnd,f,TF);
if i<0 then goto l2;
CurrentCompress:=i;
if _lread(f,@w,2)<>2 then goto l1; {Zu kurz?}
if w<>HdrSign then goto l1; {Header "DK"?}
ImagLen:=_llseek(f,0,2)-2; {Länge Datei-Körper}
if ImagLen=HFile_Error then goto l1;
_llseek(f,2,0); {Zurück-Seeken}
if not Append then ClearDkMem; {Ggf. Speicher löschen}
NewDkMem(ImagLen+TableEnd); {Speicher verlängern}
asm mov ax,PtrRec[TableEnd].Sel {Start-Pointer berechnen}
mov cx,offset __AHShift
shl ax,cl
add ax,[TableHandle]
mov PtrRec[StartP].Sel,ax
mov ax,PtrRec[TableEnd].Ofs
mov PtrRec[StartP].Ofs,ax
end;
if _hread(f,StartP,ImagLen)<>ImagLen then begin
ClearDkMem;
goto l1;
end;
Inc(TableEnd,ImagLen);
if not IsConsistent then begin {setzt Out-, In- und TimeNotify}
ClearDkMem;
goto l1;
end;
asm mov al,[DoubleOuts]
xor al,1 {False/True umschalten}
mov ah,8
call [VDongleEntry] {OUTs zusammenfassen automatisch umschalten}
call CheckOutConcat
end;
OK:=true;
l1:CloseZipFile(f,TF); {Löscht ggf. temporäre Datei}
l2:ShowCursor(false);
SetCursor(OldCurs);
SetPlayMode(OK);
if OK then begin
SetDlgItemBracketLong(101,OutNotify);
SetDlgItemBracketLong(102,InNotify);
SetDlgItemBracketLong(107,TimeNotify);
if not Append then Named:=true;
end else begin
MBox1(Wnd,14{'Fehler beim Laden der Datei %s!'},FileName);
end;
LoadDkFile:=OK;
end;
function SaveDkFile:Boolean;
label
l1,l2;
var
f: HFile;
w: Word; {Hilfsspeicher}
I: LongInt;
OK: Boolean;
OldCurs: HCursor;
P: PChar;
CZS: TCreateZipStruct;
begin
OK:=false;
if TableEnd=0 then if MBox(Wnd,7{Wirklich?},FileName)<>IDOK then exit;
if CreateZipFile(FileName,CurrentCompress,Wnd,f,CZS)<0 then goto l2;
OldCurs:=SetCursor(LoadCursor(0,IDC_Wait));
ShowCursor(true);
w:=HdrSign;
if _lwrite(f,@w,2)<>2 then goto l1; {Platte voll?}
if _hwrite(f,Ptr(TableHandle,0),TableEnd)<>TableEnd {Alles schreiben}
then goto l1;
OK:=true;
l1:CreateZipClose(f,CZS);
ShowCursor(false);
SetCursor(OldCurs);
l2:if OK then Dirty:=false
else MBox1(Wnd,17{Fehler beim Speichern...},FileName);
SaveDkFile:=OK;
end;
procedure SplitCmdLine;
var
S: array[byte]of Char;
I: Integer;
begin
for I:=1 to GetArgCount do begin
GetArgStr(S,I,sizeof(S)-1);
if S[0] in ['/','-'] then begin
{Testmodus bei vorhandenem Kommandozeilenparameter aktivieren}
if lStrCmpi(S+1,'title')=0 then begin
Inc(I);
GetArgStr(S,I,sizeof(S)-1);
StdMBoxTitle:=StrNew(S);
SetWindowText(Wnd,S);
end else if lStrCmpi(S+1,'run')=0 then begin
Inc(I);
GetArgStr(AutoRun,I,sizeof(AutoRun)-1);
end else if lStrCmpi(S+1,'hidden')=0 then begin
CmdShow:=SW_Hide;
end else if lStrCmpi(S+1,'quiet')=0 then begin
if PtrRec(VDongleEntry).Sel<>0 then
asm
mov ax,400h {Speaker-Sound löschen}
call [VDongleEntry]
end;
end else begin
MBox1(Wnd,11{Unbekannte Kommandozeilen-Option...},S);
end;
end else begin
lStrCpy(FileName,S);
end;
end{for};
end;
procedure RunExe;
var
ChildInst: THandle;
S: array[byte]of Char;
vsrec: record
WO: Word;
SP: PChar;
end;
begin
SetExeTermNotify(Wnd,WM_Close);
ChildInst:=WinExec(AutoRun,SW_Show);
if ChildInst<32 then begin
vsrec.SP:=AutoRun;
vsrec.WO:=ChildInst;
MBox(Wnd,12{Fehler Code %u...},vsrec);
ChildInst:=0;
end;
end;
procedure ShowLptAssign;
begin
MBox(Wnd,3{Die LPTs liegen...},Mem[Ofs(__0040H):8]);
end;
procedure ShowAboutBox;
var
S: array[0..1024] of Char;
vsrec: record
Hi,Lo: Word;
end;
begin
vsrec.Hi:=WordRec(VDongleVer).Hi;
vsrec.Lo:=WordRec(VDongleVer).Lo;
MBox(Wnd,4{Lernfähiger virtueller...},vsrec);
end;
procedure ChangeSysMenu;
var
SysMenu: HMenu;
S:array[0..31] of Char;
begin
SysMenu:=GetSystemMenu(Wnd,false); {Systemmenü-Handle}
DeleteMenu(SysMenu,SC_Maximize,MF_ByCommand);
DeleteMenu(SysMenu,SC_Size,MF_ByCommand);
LoadString(Seg(HInstance),1,S,sizeof(S));
InsertMenu(SysMenu,0,MF_ByPosition or MF_String,22,S);
LoadString(Seg(HInstance),2,S,sizeof(S));
InsertMenu(SysMenu,1,MF_ByPosition or MF_String,23,S);
InsertMenu(SysMenu,2,MF_ByPosition or MF_Separator,0,nil);
end;
function ZipDlgProc(Window:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
begin
ZipDlgProc:=false;
case Msg of
WM_InitDialog: begin
SetDlgItemText(Window,101,Zipper);
SetDlgItemText(Window,102,Unzipper);
case DOSShowCmd of
SW_Hide: wParam:=0;
SW_Minimize, SW_ShowMinimized, SW_ShowMinNoActive: wParam:=2;
else wParam:=1;
end;
CheckDlgButton(Window,103,wParam);
end;
WM_Command: case wParam of
ID_OK: begin
GetDlgItemText(Window,101,Zipper,sizeof(Zipper));
WriteProfileString(AppName,'Zipper',Zipper);
GetDlgItemText(Window,102,Unzipper,sizeof(Unzipper));
WriteProfileString(AppName,'Unzipper',Unzipper);
wParam:=IsDlgButtonChecked(Window,103);
case wParam of
0: DOSShowCmd:=SW_Hide;
2: DOSShowCmd:=SW_ShowMinNoActive;
else DOSShowCmd:=SW_ShowNoActivate;
end;
WriteProfileInt(AppName,'DOSShowCmd',DOSShowCmd);
EndDialog(Window,1);
end;
ID_Cancel: EndDialog(Window,0);
end;
end;
end;
function PMIconDlgProc(Window:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
begin
PMIconDlgProc:=false;
case Msg of
WM_InitDialog: begin
end;
WM_Command: case wParam of
ID_OK: begin
EndDialog(Window,1);
end;
ID_Cancel: EndDialog(Window,0);
end;
end{case};
end;
procedure ResetCounts; assembler;
asm
db $66; xor ax,ax
db $66; mov word ptr [AccessOutCount],ax
db $66; mov word ptr [AccessInCount],ax
db $66; mov word ptr [AccessFails],ax
db $66; mov word ptr [AccessTimeCount],ax
end;
function SaveFileAs:Boolean;
begin
SaveFileAs:=false;
LoadString(Seg(HInstance),15,OfnFilter,sizeof(OfnFilter));
ofn.Flags:=ofn.Flags or OFN_HideReadOnly;
ofn.nFilterIndex:=CurrentCompress+1;
if GetSaveFileName(ofn) then begin
Named:=true;
if ofn.nFilterIndex<=3 then CurrentCompress:=ofn.nFilterIndex-1;
SaveFileAs:=SaveDkFile;
end;
end;
function SaveFile:Boolean;
begin
if Named then SaveFile:=SaveDkFile
else SaveFile:=SaveFileAs;
end;
function CheckDirtyOK: Boolean;
begin
CheckDirtyOK:=true;
if Dirty and WarnIfDirty then begin
case MBox1(Wnd,22{Geändert-Speichern?},@FileName) of
IDYes: CheckDirtyOK:=SaveFile;
IDNo: Dirty:=false; {Nicht 2x fragen (z.B. beim Windows beenden)}
IDCancel: CheckDirtyOK:=false;
end;
end;
end;
var
OldExit: Pointer;
{Exit-Behandlung, um bei auftretenden Laufzeitfehlern das VxD
über das Ableben des Callbacks zu informieren! 386 ist vorausgesetzt}
procedure NewExit; far; assembler;
asm
db $66; mov ax,word ptr [OldExit]
db $66; mov word ptr [ExitProc],ax
mov ah,2 {Callback löschen}
call [VDongleEntry]
mov ax,$700
call [VDongleEntry] {Trapping ausschalten}
end;
function GetVDongleStates:Integer;
{Unbedingte Voraussetzung: 386er Prozessor und gültiges Fenster-Handle!
Darf nur 1x aufgerufen werden! Return-Werte:
-4: kein Enhanced Mode Windows,
-3: Kein VDONGLE.386 geladen,
-2: VDONGLE geladen, aber falsche Version (Nummer steht in VDongleVer)
-1: VDONGLE geladen, aber Fehler bei Puffer-Initialisierung
0: Alles OK, entsprechende Dialogelemente freigeschaltet}
begin
GetVDongleStates:=-4;
if GetWinFlags and WF_Enhanced =0 then exit;
GetVDongleStates:=-3;
if PtrRec(VDongleEntry).Sel=0 then exit;
GetVDongleStates:=-2;
asm mov ah,0 {Versions-Abfrage}
call [VDongleEntry]
mov [VDongleVer],ax {Globale Variable setzen}
end;
if VDongleVer<$104 then exit; {Erforderliche Version wird nicht erreicht}
GetVDongleStates:=-1;
asm mov ax,$701
call [VDongleEntry] {Trapping einschalten}
mov bx,offset TheCallback
push cs
pop es
mov ah,1 {Callback setzen}
call [VDongleEntry]
xor bx,bx
mov es,bx
mov cx,MaxBuffer+1
mov ah,5 {Puffer allozieren lassen}
call [VDongleEntry]
mov [BufSel],ax
push cs
push offset NewExit
db $66; pop ax
db $66; xchg word ptr [ExitProc],ax
db $66; mov word ptr [OldExit],ax
end;
if BufSel=0 then exit; {Fehler im VxD?}
GetVDongleStates:=0;
EnableWindow(GetDlgItem(Wnd,104),true); {Aufnahme/Wiedergabe}
EnableWindow(GetDlgItem(Wnd,105),true); {Lautsprecher-Tick}
EnableWindow(GetDlgItem(Wnd,106),true); {Uhrzeit-Trap}
asm
mov ax,300h {Virtualisierung beim Einschalten AUS}
call [VDongleEntry]
mov ax,4FFh {Lautsprecher-Status abfragen}
call [VDongleEntry]
cbw
push [Wnd] {Wnd}
push 105 {ID}
push ax {NewState}
call CheckDlgButton
mov ax,6FFh {Uhrzeit-Grabbing-Status abfragen}
call [VDongleEntry]
cbw
push [Wnd] {Wnd}
push 106 {ID}
push ax {NewState}
call CheckDlgButton
{Checkmark für "Outs zusammenfassen"}
call CheckOutConcat
end;
end;
procedure InstallVxD;
begin
AddVxDToSystemIni;
if MBox1(0,10{Windows-Neustart},nil)=ID_Yes then begin
ExitWindows(EW_RestartWindows,0);
end;
end;
function DialogProc(Window:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
S: array[0..255]of Char;
SP: PChar absolute lParam;
lPar: LongRec absolute lParam;
i,k: Integer;
begin
DialogProc:=false;
case Msg of
WM_InitDialog: begin
Wnd:=Window; {Globale Variable setzen}
Posted:=false;
ResetCounts;
SetDlgItems('%ld'); {Zähler rücksetzen}
ChangeSysMenu;
if WarnIfDirty
then CheckMenuItem(GetMenu(Wnd),18,MF_ByCommand or MF_Checked);
ofn.hWndOwner:=Wnd;
ShowWindow(Wnd,CmdShow); {Icon? - Sofort wirksam machen!}
PostMessage(Wnd,WM_ContinueInit,0,0);
end;
WM_ContinueInit: begin
UpdateWindow(Wnd); {würde in InitDialog nichts bringen !!}
InitDkMem; {Speicherblock beschaffen}
AutoRun[0]:=#0;
FileName[0]:=#0;
SplitCmdLine; {verändert CmdShow}
DragAcceptFiles(Wnd,true);
UpdateRegistry;
if FileName[0]<>#0 then LoadDkFile(FileName,false);
case GetVDongleStates of
-4: MBox1(Wnd,19{Erweiterter Modus},nil);
-3: if MBox1(Wnd,8{VDONGLE nicht geladen},nil)=ID_Yes then InstallVxD;
-2: if MBox1(Wnd,9{Falsche Version},nil)=ID_Yes then InstallVxD;
-1: MBox1(Wnd,21{Interner Fehler},nil);
end;
ShowWindow(Wnd,CmdShow);
{SW_Hide darf erst bei sichtbarem Fenster benutzt werden, warum auch immer}
if AutoRun[0]<>#0 then RunExe;
end;
WM_DongleAccess: begin
SetDlgItems('%ld');
if not PlayMode then Dirty:=true;
Posted:=false; {ASM kann wieder POSTen}
end;
WM_SysCommand: case wParam of
22: begin
if GetMenuState(GetSystemMenu(Window,false),wParam,MF_ByCommand)
and MF_Checked <>0 then begin
lPar.Hi:=HWND_NoTopmost;
lPar.Lo:=MF_ByCommand or MF_UnChecked;
end else begin
lPar.Hi:=HWND_Topmost;
lPar.Lo:=MF_ByCommand or MF_Checked;
end;
SetWindowPos(Window,lPar.Hi,0,0,0,0,SWP_NoMove or SWP_NoSize);
CheckMenuItem(GetSystemMenu(Window,false),wParam,lPar.Lo);
end;
23: ShowWindow(Window,SW_Hide);
end;
WM_QueryEndSession: if not CheckDirtyOK then DialogProc:=true;
WM_Command: case wParam of
9: WinHelp(Wnd,HelpFileName,HELP_Contents,0);
13: ShowLptAssign;
14: if MBox1(Wnd,5{...Vor-Allokation...},PChar(TableSize))=IDYes
then NewDkMem($100000+TableSize);
15: DialogBox(Seg(HInstance),MakeIntResource(15),Wnd,@ZipDlgProc);
16: asm
mov ax,$8FF
call [VDongleEntry]
xor al,1 {False/True umschalten}
call [VDongleEntry]
call CheckOutConcat
end;
999: ShowAboutBox;
IDCancel: begin
if not CheckDirtyOK then exit;
WinHelp(Wnd,HelpFileName,HELP_Quit,0);
DragAcceptFiles(Wnd,false);
ClearDkMem; {Speicher abräumen}
DoneDkMem; {Pointerliste entfernen}
EndDialog(Wnd,0);
end;
104: SetPlayMode(Bool(IsDlgButtonChecked(Wnd,104)));
105: asm
push [Wnd]
push 105
call IsDlgButtonChecked {Ergebnis nach AL}
mov ah,4 {Speaker-Sound setzen/löschen}
call [VDongleEntry]
end;
106: asm
push [Wnd]
push 106
call IsDlgButtonChecked {Ergebnis nach AL}
mov ah,6 {Uhrzeit-Trap ein/aus}
call [VDongleEntry]
end;
20: begin {NEW}
if not CheckDirtyOK then exit;
ClearDkMem;
ResetCounts;
SetDlgItems('%ld');
Named:=false;
FileName[0]:=#0;
SetPlayMode(false);
end;
10: begin {LOAD}
LoadString(Seg(HInstance),16,OfnFilter,sizeof(OfnFilter));
ofn.Flags:=ofn.Flags and not OFN_HideReadOnly and not OFN_ReadOnly;
if TableEnd=0 then ofn.Flags:=ofn.Flags or OFN_HideReadOnly;
ofn.nFilterIndex:=0;
lstrcpy(S,FileName); {Dateiname retten für's Anhängen}
if GetOpenFileName(ofn) then begin
if ofn.Flags and OFN_ReadOnly <>0 then begin
LoadDkFile(FileName,true); {Ohne zu fragen: anhängen!}
lstrcpy(FileName,S); {alter Dateiname!}
dirty:=true; {und diese ist und bleibt DIRTY!}
end else begin
if not CheckDirtyOK then exit; {Erst fragen, dann laden!}
LoadDkFile(FileName,false); {laden - setzt DIRTY auf FALSE}
end;
end;
end;
11: SaveFileAs; {SAVE AS}
19: SaveFile; {SAVE}
18: begin {WARN IF DIRTY}
lPar.Hi:=GetMenu(Wnd);
if GetMenuState(lPar.Hi,wParam,MF_ByCommand)
and MF_Checked <>0 then begin
WarnIfDirty:=false;
lPar.Lo:=MF_ByCommand or MF_UnChecked;
end else begin
WarnIfDirty:=true;
lPar.Lo:=MF_ByCommand or MF_Checked;
end;
CheckMenuItem(lPar.Hi,wParam,lPar.Lo);
WriteProfileInt(AppName,'WarnIfDirty',Word(WarnIfDirty));
end;
12: begin {0-Setz}
ResetCounts;
SetDlgItems('%ld');
end;
{"Installation"-Menü}
30: begin {Programm-Manager-Icon}
DialogBox(Seg(HInstance),MakeIntResource(30),Wnd,@PMIconDlgProc);
end;
31: begin {VDONGLE in SYSTEM.INI hinein}
if MBox1(0,23,nil)=ID_OK then InstallVxD;
end;
32: begin {VDONGLE aus SYSTEM.INI löschen}
if MBox1(0,24,nil)=ID_OK then AddRemoveVxD(nil,VxDName);
end;
33: begin {Komplett deinstallieren}
if MBox1(0,25,nil)=ID_OK then begin
AddRemoveVxD(nil,VxDName); {VxD aus SYSTEM.INI 'raus}
RegDeleteKey(HKCR,'.DK'); {REG.DAT-Einträge 'raus}
RegDeleteKey(HKCR,'.DK_');
RegDeleteKey(HKCR,'.DKZ');
RegDeleteKey(HKCR,'DKnack');
WriteProfileString(AppName,nil,nil); {WIN.INI-Einträge 'raus}
WinHelp(Wnd,HelpFileName,HELP_Quit,0);
SP:=GetExePath(S);
_ldelete(S); {EXE selbst killen...}
lstrcpy(SP,HelpFileName);
_ldelete(S); {...die Hilfe...}
lstrcpy(SP,VxDName);
_ldelete(S); {...und das VxD}
EndDialog(Wnd,0);
end;
end;
end;
WM_DropFiles: begin
k:=DragQueryFile(wParam,$FFFF,nil,0);
for i:=0 to k-1 do begin
DragQueryFile(wParam,i,S,sizeof(S));
if not named then begin
lstrcpy(FileName,S); {Der erste Dateiname bestimmt den Namen}
named:=true;
end;
LoadDkFile(S,true);
end;
end;
end;
end;
const
wc:TWndClass=(
style: CS_VRedraw or CS_HRedraw;
lpfnWndProc: @DefDlgProc;
cbClsExtra: 0;
cbWndExtra: DlgWindowExtra;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground:Color_Background+1;
lpszMenuName: nil;
lpszClassName:'DKNACK');
begin
WUtils.StdMBoxTitle:=@AppName; {MessageBox-Titel in Unit setzen}
if Test8086<2 then begin
MBox1(0,20{mind.386SX},nil);
halt(86);
end;
if HPrevInst<>0 then begin {Nicht doppelt starten!}
ShowWindow(FindWindow('DKNACK',nil),SW_Restore);
halt(221);
end;
wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
GetProfileString(AppName,'Zipper',Zipper,Zipper,sizeof(Zipper));
GetProfileString(AppName,'Unzipper',Unzipper,Unzipper,sizeof(Unzipper));
DOSShowCmd:=GetProfileInt(AppName,'DOSShowCmd',DOSShowCmd);
WarnIfDirty:=Bool(GetProfileInt(AppName,'WarnIfDirty',Word(WarnIfDirty)));
DialogBox(Seg(HInstance),MakeIntResource(100),0,@DialogProc);
end.
{Software-Schrott aus alten Tagen}
function LFN_ToLong(Src,Dest:PChar; DestLen:Word):Bool; assembler;
{Der Hilfspuffer sorgt dafür, daß Src und Dest gleich sein dürfen}
var
S:array[0..259]of Char;
asm push ds
lds si,[Src]
lea di,[S]
push ss
pop es
mov cx,$0000
stc
mov ax,$7160
call DOS3Call
pop ds
push LongRec[Dest].Hi
push LongRec[Dest].Lo
mov si,true
jnc @@noerr
les di,[Src]
dec si {False}
@@noerr:
push es
push di
mov ax,[DestLen]
dec ax
push ax
call lstrcpyn
xchg ax,si
end;
WM_Command: case wParam of
ID_OK: begin
E:=SendDlgItemMessage(Wnd,1121,LB_GetCount,0,0);
for I:=0 to E-1 do begin
SendDlgItemMessage(Wnd,1121,LB_GetText,I,LongInt(@S));
LFN_ToLong(S,S,sizeof(S));
SendDlgItemMessage(Wnd,1121,LB_DeleteString,I,0);
SendDlgItemMessage(Wnd,1121,LB_InsertString,I,LongInt(@S));
end;
E:=SendDlgItemMessage(Wnd,1120,LB_GetCount,0,0);
for I:=0 to E-1 do begin
SendDlgItemMessage(Wnd,1120,LB_GetText,I,LongInt(@S));
LFN_ToLong(S,S,sizeof(S));
SendDlgItemMessage(Wnd,1120,LB_DeleteString,I,0);
SendDlgItemMessage(Wnd,1120,LB_InsertString,I,LongInt(@S));
end;
GetDlgItemText(Wnd,1088,S,sizeof(S));
LFN_ToLong(S,S,sizeof(S));
SetDlgItemText(Wnd,1088,S);
end;
end;
| Detected encoding: OEM (CP437) | 1
|
|
|