{$A+,B-,F-,G+,I-,K+,N-,P-,Q-,R-,S-,T-,V+,W-,X+}
{$M 8192,8192}
program VTGWATCH;
uses WinProcs,WinTypes,Win31,CommDlg,WinDos;
{$D VTGrab-Watch 1.01 (01/97)}
{$R VTGWATCH}
const
AppNam:array[0..8]of Char='VTGWATCH'#0; {Kurzform}
AppName:array[0..12]of Char='VTGrab-Watch'#0; {Langform}
HelpFile:array[0..12]of Char='VTGWATCH.HLP'#0; {Hilfedatei}
IniFile: array[0..6]of Char='VT.INI'#0; {INI-Datei}
var
Millisecs:Word;
const
PermanentOpen:Bool=false;
type
LongRec=record
Lo,Hi:Word;
end;
TCPRec=record
MS:Word;
PO:Bool;
end;
function LongMul(F1,F2:Integer):LongInt;
inline($5A/$58/$F7/$EA); {pop dx; pop ax; imul dx}
function LongDiv(Z:LongInt; N:Integer):Integer;
inline($59/$58/$5A/$F7/$F9); {pop cx; pop ax; pop dx; idiv cx}
function ConfProc(HWindow:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
var
CPR:^TCPRec absolute lParam;
begin
ConfProc:=false;
case Msg of
WM_InitDialog: begin
SetWindowLong(HWindow,DWL_User,lParam); {einspeichern}
SetDlgItemInt(HWindow,101,CPR^.MS,false);
CheckDlgButton(HWindow,102,Word(CPR^.PO));
end;
WM_Command: case wParam of
IDOK: begin
lParam:=GetWindowLong(HWindow,DWL_User); {herausholen}
CPR^.MS:=GetDlgItemInt(HWindow,101,nil,false);
CPR^.PO:=Bool(IsDlgButtonChecked(HWindow,102));
EndDialog(HWindow,1);
end;
IDCancel: EndDialog(HWindow,0);
end;
end;
end;
function AboutProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
begin
AboutProc:=false;
if (Msg=WM_Command) and (wParam=ID_OK)
then EndDialog(Wnd,1);
end;
type
HFile=Integer;
TIdx=record
case integer of
1: (Page,Subp:word);
2: (L:LongInt);
end;
const
HFile_Error=-1;
var
VREQFile: HFile;
VREQ: record
CurVT: array[0..8]of char;
GarbFlg: byte;
ctrl0: word;
ctrl1: word;
FuzzySender: byte;
FuzzyQuality: byte;
req: array[0..7]of TIdx; {Request-Indizes}
end;
const
FName: array[byte]of Char='\\toaster_105\d_toa\vt\vreq100.vtd';
function SelectFile(HWindow:HWnd):Bool;
var
ofn: TOpenFileName;
begin
SelectFile:=false;
FillChar(ofn,sizeof(ofn),0);
ofn.lStructSize:=sizeof(ofn);
ofn.hWndOwner:=HWindow;
ofn.hInstance:=Seg(AppNam);
ofn.lpstrFilter:='VTD-Datei (VREQ???.VTD)'#0'vreq???.vtd'#0+
'Alle Dateien (*.*)'#0'*.*'#0;
ofn.lpstrFile:=FName;
ofn.nMaxFile:=sizeof(FName);
ofn.lpstrTitle:='Datei überwachen';
{ ofn.Flags:=OFN_NoReadOnlyReturn or OFN_CreatePrompt or OFN_HideReadOnly;}
SelectFile:=GetOpenFileName(ofn);
end;
function TestBit(W:Word; BN:Integer):Word; {liefert 0 oder 1}
begin
TestBit:=Word(W and (1 shl BN)<>0);
end;
function UsualPage(P:Word):Word; assembler;
asm
mov ax,[P]
and ax,$7FF
or ah,ah
jnz @@1
add ah,8
@@1:
end;
function SetHex(HWindow:HWnd; Item:Word; Hexval:Word):Bool;
var
S: array[0..31]of Char;
begin
wvsprintf(S,'%X',HexVal);
SetDlgItemText(HWindow,Item,S);
SetHex:=true;
end;
function GetHex(HWindow:HWnd; Item:Word; var Hexval:Word):Bool;
var
S: array[0..31]of Char;
EC: Integer;
begin
S[0]:='$'; GetDlgItemText(HWindow,Item,@S[1],sizeof(S)-1);
val(S,HexVal,EC);
GetHex:=EC=0;
end;
function DialogProc(HWindow:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
const
WM_VisSelect=WM_User+16;
WM_Changed=WM_User+17;
WM_NewTitle=WM_User+18;
WM_NewTimer=WM_User+19;
WM_FileLoad=WM_User+20;
WM_FileSave=WM_User+21;
WM_CalcHexFlag=WM_User+22;
const
VisGrp: Integer=1;
TimeStamp: LongInt=0; {Zeitstempel fr Ver„nderungs-Untersuchung}
var
lParP: Pointer absolute lParam;
var
I,J,K: Integer;
W: Word;
SysMenu: HMenu;
S: array[byte]of Char;
SK: array[0..31]of Char;
TwoSP: record
SP1,SP2:PChar;
end;
CPR: TCPRec;
SR: TSearchRec;
const
F: HFile=HFile_Error; {Unge”ffnet!}
procedure CheckFileSize; {lokales Unterprogramm}
begin
FileSplit(FName,S,nil,nil); {Pfad abspalten}
lstrcat(S,VREQ.CurVT);
lstrcat(S,'.VT');
FindFirst(S,0,SR);
{Datei nicht ”ffnen wegen Sharing-Problemen unter Novell-DOS}
if DosError=0 then
SetDlgItemInt(HWindow,105,Word(LongDiv(SR.Size,1024)),true);
end;
procedure WriteWord(KeyName:PChar; State: Word);
begin
wvsprintf(SK,'%u',State);
WritePrivateProfileString(AppNam,KeyName,SK,S);
end;
begin
DialogProc:=false;
case Msg of
WM_InitDialog: begin
SysMenu:=GetSystemMenu(HWindow,false); {das Handle}
DeleteMenu(SysMenu,SC_Maximize,MF_ByCommand);
DeleteMenu(SysMenu,SC_Size,MF_ByCommand);
FileSplit(FName,S,nil,nil);
lstrcat(S,IniFile);
CheckDlgButton(HWindow,197,GetPrivateProfileInt(AppNam,'autoread',0,S));
CheckDlgButton(HWindow,198,GetPrivateProfileInt(AppNam,'autowrite',0,S));
PostMessage(HWindow,WM_NewTimer,GetPrivateProfileInt(
AppNam,'autoreadtime',1000,S),0); {Timer setzen}
CheckDlgButton(HWindow,192,1);
SendMessage(HWindow,WM_FileLoad,0,LongInt(@FName));
SendMessage(HWindow,WM_VisSelect,0,1);
SendMessage(HWindow,WM_NewTitle,0,LongInt(@FName));
end;
WM_FileLoad: begin
if F=HFile_Error
then F:=_lopen(lParP,0); {zum Lesen ”ffnen}
if F<>HFile_Error then begin
asm
mov ax,$5700
mov bx,[F]
int $21
mov word ptr [TimeStamp],cx
mov word ptr [TimeStamp+2],dx {Uhrzeit setzen}
end;
_lRead(F,@VReq,sizeof(VReq));
SetDlgItemText(HWindow,101,VReq.CurVT);
SetDlgItemInt(HWindow,102,VReq.GarbFlg,false);
SetDlgItemInt(HWindow,103,VReq.FuzzySender,false);
SetDlgItemInt(HWindow,104,VReq.FuzzyQuality,false);
K:=128;
for I:=0 to 15 do begin
CheckDlgButton(HWindow,K,TestBit(VReq.ctrl0,I));
Inc(K);
end;
for I:=0 to 15 do begin
CheckDlgButton(HWindow,K,TestBit(VReq.ctrl1,I));
Inc(K);
end;
K:=256;
for I:=0 to 7 do with VReq.req[I] do begin
for J:=15 downto 11 do begin
CheckDlgButton(HWindow,K,TestBit(Page,J));
Inc(K);
end;
SetHex(HWindow,K,UsualPage(Page));
Inc(K,8-5);
for J:=15 downto 14 do begin
CheckDlgButton(HWindow,K,TestBit(SubP,J));
Inc(K);
end;
SetHex(HWindow,K,SubP and $3F7F);
Inc(K,8-2);
end;
if not PermanentOpen then begin
_lClose(F);
F:=HFile_Error; {Kennung: Handle geschlossen!}
end;
SendMessage(HWindow,WM_CalcHexFlag,0,0);
end;
end;
WM_FileSave: begin
F:=_lOpen(lParP,1); {zum Schreiben ”ffnen}
if F<>HFile_Error then begin
GetDlgItemText(HWindow,101,VReq.CurVT,9);
{$R-}
VReq.GarbFlg:=GetDlgItemInt(HWindow,102,nil,false);
VReq.FuzzySender:=GetDlgItemInt(HWindow,103,nil,false);
VReq.FuzzyQuality:=GetDlgItemInt(HWindow,104,nil,false);
K:=128;
VReq.ctrl0:=0;
for I:=0 to 15 do begin
if IsDlgButtonChecked(HWindow,K)=1
then VReq.ctrl0:=VReq.ctrl0 or (1 shl I);
Inc(K);
end;
VReq.ctrl1:=0;
for I:=0 to 15 do begin
if IsDlgButtonChecked(HWindow,K)=1
then VReq.ctrl1:=VReq.ctrl1 or (1 shl I);
Inc(K);
end;
K:=256;
for I:=0 to 7 do with VReq.req[I] do begin
Page:=Page and $7FF; {Alte Seite ausmaskieren}
if GetHex(HWindow,K+5,W) then Page:=W and $7FF;
for J:=15 downto 11 do begin
if IsDlgButtonChecked(HWindow,K)=1
then Page:=Page or (1 shl J);
Inc(K);
end;
Inc(K,8-5);
SubP:=SubP and $3F7F; {Alte Unterseite ausmaskieren}
if GetHex(HWindow,K+2,W) then SubP:=W and $3F7F;
for J:=15 downto 14 do begin
if IsDlgButtonChecked(HWindow,K)=1
then SubP:=SubP or (1 shl J);
Inc(K);
end;
Inc(K,8-2);
end;
_lWrite(F,@VReq,sizeof(VReq));
_lClose(F);
end;
end;
WM_Command: case wParam of
1: begin
CheckFileSize;
SendMessage(HWindow,WM_FileLoad,0,LongInt(@FName));
end;
IDCancel: EndDialog(HWindow,1);
9: WinHelp(HWindow,HelpFile,HELP_Contents,0);
10: MessageBox(HWindow,'Prüfen nicht implementiert',AppName,MB_OK);
11: SendMessage(HWindow,WM_FileSave,0,LongInt(@FName));
514: if SelectFile(HWindow) then begin
if F<>HFile_Error then begin
_lclose(F);
F:=HFile_Error;
end;
SendMessage(HWindow,WM_NewTitle,0,LongInt(@FName));
end;
515: begin {Aktualisierung...}
CPR.MS:=MilliSecs;
CPR.PO:=PermanentOpen;
if DialogBoxParam(Seg(AppNam),MakeIntResource(wParam),
HWindow,@ConfProc,LongInt(@CPR))<>0 then begin
SendMessage(HWindow,WM_NewTimer,CPR.MS,0);
PermanentOpen:=CPR.PO;
end;
end;
516: begin {Konfiguration speichern}
FileSplit(FName,S,nil,nil);
lstrcat(S,IniFile);
WriteWord('autoread',IsDlgButtonChecked(HWindow,197));
WriteWord('autowrite',IsDlgButtonChecked(HWindow,198));
WriteWord('autoreadtime',Millisecs);
end;
909: begin {šber}
DialogBox(Seg(AppNam),MakeIntResource(wParam),HWindow,@AboutProc);
end;
192..195: SendMessage(HWindow,WM_VisSelect,wParam-192,0);
128..135: SendMessage(HWindow,WM_VisSelect,0,1);
136..143: SendMessage(HWindow,WM_VisSelect,1,1);
144..151: SendMessage(HWindow,WM_VisSelect,2,1);
152..159: SendMessage(HWindow,WM_VisSelect,3,1);
end;
WM_VisSelect: begin {Erkl„rung setzen, wParam=neue Selektion}
if wParam<>VisGrp then begin
J:=160+8*VisGrp;
K:=160+8*wParam;
for I:=0 to 7 do begin
ShowWindow(GetDlgItem(HWindow,J),SW_Hide); Inc(J);
ShowWindow(GetDlgItem(HWindow,K),SW_Show);
UpdateWindow(GetDlgItem(HWindow,K)); Inc(K);
end;
VisGrp:=wParam;
CheckRadioButton(HWindow,192,195,192+VisGrp);
end;
if LoWord(lParam)<>0 then SendMessage(HWindow,WM_CalcHexFlag,0,0);
end;
WM_CalcHexFlag: begin
K:=128; lParam:=0; {lParam als Akku miábrauchen}
for I:=0 to 31 do begin
if IsDlgButtonChecked(HWindow,K)=1
then lParam:=lParam or (LongInt(1) shl I);
Inc(K);
end;
wvsprintf(SK,'%08lX',lParam);
SetDlgItemText(HWindow,196,SK);
end;
WM_NewTitle: begin
if lParP=nil then SetWindowText(HWindow,AppName)
else begin
TwoSP.SP1:=AppName; GetFileTitle(lParP,SK,sizeof(SK));
TwoSP.SP2:=SK;
wvsprintf(S,'%s - %s',TwoSP);
SetWindowText(HWindow,S);
end;
end;
WM_NewTimer: begin {wParam=neue Millisekunden}
KillTimer(HWindow,101);
MilliSecs:=wParam;
if Millisecs<>0 then SetTimer(HWindow,101,Millisecs,nil);
end;
WM_Timer: begin
if Bool(IsDlgButtonChecked(HWindow,197)) then begin
CheckFileSize;
FindFirst(FName,0,SR);
if SR.Time<>TimeStamp then begin
MessageBeep(0); {Ding bei Žnderungen!}
SendMessage(HWindow,WM_FileLoad,0,LongInt(@FName));
end;
end;
end;
WM_Changed: begin
if Bool(IsDlgButtonChecked(HWindow,198)) then begin
SendMessage(HWindow,WM_FileSave,0,LongInt(@FName));
end;
end;
WM_Destroy: begin
SendMessage(HWindow,WM_NewTimer,0,0); {effektiv Timer killen}
WinHelp(HWindow,HelpFile,HELP_Quit,0); {Hilfe schlieáen}
end;
end{case};
if (Msg=WM_Command)
and ((wParam>=128) and (wParam<160) {nur bei Checkboxen in den Matzizen}
or (wParam>=256) and (wParam<384))
and (LongRec(lParam).Hi=BN_Clicked) {trifft nur auf Buttons zu!}
then SendMessage(HWindow,WM_Changed,0,0);
end;
const
wc: TWndClass=(
style: CS_HRedraw or CS_VRedraw;
lpfnWndProc: @DefDlgProc;
cbClsExtra: 0;
cbWndExtra: DlgWindowExtra;
hInstance: Seg(AppNam);
hIcon: 0;
hCursor: 0;
hbrBackground: Color_Background+1;
lpszMenuName: MakeIntResource(1);
lpszClassName: AppNam);
begin
if HPrevInst=0 then begin
wc.hIcon:=LoadIcon(Seg(AppNam),MakeIntResource(1));
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
end;
if lstrlen(CmdLine)<>0 then lstrcpy(FName,CmdLine);
DialogBox(Seg(AppNam),MakeIntResource(1),0,@DialogProc);
end.
| Detected encoding: UTF-8 | 0
|