[fpc-pascal]mysterious error
Hans Mårtensson
hm at os.dk
Wed Dec 18 20:17:00 CET 2002
I've got a problem with an error in a Windows program that I cannot locate.
It is about the following procedure:
Procedure OpenFile;
var datafile: file;
Begin
Assign(datafile,'C:\pp\work\a');
Reset(datafile,1); if IOResult<>0 then exit;
Close(datafile);
end;
This procedure, when called from the menu in a window, does nothing and
does no harm.
(The file mentioned exists.)
BUT if I remove the file declaration and put it at the top of the program
to make it a global variabel, the procedure makes the system crash.
The error is a general protection error in modul kernel32.dll.
I enclose the full test program that crashes (on my machine).
In this test program the procedure 'vis' shows the file length in a message
box, and this is shown correct.
Only after pressing the OK button, the program crashes, which shows that it
is on returning from the procedure that the error is invoked.
Maybe something in the windows program is rotten, but what?
(I've taken it mostly from the examples that comes with the Free Pascal
system.)
And how can it be infered by moving the declaration of the file from the
procedure to the program?
Can anyone help me with solving this riddle?
Here is the full testprogram that crashes.
(But add the datafile declaration to the OpenFile procedure, and it works.)
(All this asumes that the file C:\pp\work\a exists.)
//*****************************************************
{$APPTYPE GUI}
{$I-}
Uses Windows;
Const
AppName = 'test';
Var
AMessage: Msg;
hWindow: HWnd;
WindowClass: WndClass;
Menu: hMenu;
datafile: file;
procedure vis(txt: PChar; n: integer);
var p: PChar; i: integer;
begin p:='Værdi= *'; if n<10000 then begin
i:=n div 1000; n:=n-i*1000; if i>0 then p[8]:=chr(48+i);
i:=n div 100; n:=n-i*100; if i>0 then p[9]:=chr(48+i);
i:=n div 10; n:=n-i*10; if i>0 then p[10]:=chr(48+i);
i:=n mod 10; p[11]:=chr(48+i); end;
MessageBox(hWindow,p,txt, MB_OK);
end;
Procedure SaveText;
Begin
MessageBox(hWindow,'Not implemented',nil, MB_OK);
End;
Procedure OpenFile;
Var Len: LongInt;
Begin
Assign(datafile,'C:\pp\work\a');
Reset(datafile,1); if IOResult<>0 then exit;
Len := FileSize(datafile); if IOResult<>0 then exit;
vis('LEN',len);
Close(datafile);
end;
Function WindowProc(Window:HWnd;AMessage : UINT; WParam : WParam;
LParam:LParam): LResult; export;
Var
ps: paintstruct;
dc: hdc;
r: rect;
nrmenu : longint;
Begin WindowProc := 0;
Case AMessage Of
wm_Paint: Begin
dc:=BeginPaint(Window, at ps);
GetClientRect(Window, at r);
DrawText(dc,'Testprogram',-1, at r, DT_SINGLELINE or DT_CENTER or
DT_VCENTER);
EndPaint(Window,ps);
Exit; End;
wm_Destroy: Begin PostQuitMessage (0); Exit; End;
wm_Command: Begin
NrMenu := WParam And $FFFF;
Case NrMenu Of
101: Openfile;
102: SaveText;
103: PostMessage(Window,WM_Close,0,0);
End;
End;
End;
WindowProc := DefWindowProc(Window,AMessage,WParam,LParam);
End;
Function WinRegister: Boolean;
Begin
With WindowClass Do
Begin
Style := cs_hRedraw Or cs_vRedraw;
lpfnWndProc := WndProc(@WindowProc);
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := system.MainInstance;
hIcon := LoadIcon (0,idi_Application);
hCursor := LoadCursor (0,idc_Arrow);
hbrBackground := GetStockObject(WHITE_BRUSH);
lpszMenuName := 'Files';
lpszClassName := AppName;
End;
WinRegister := RegisterClass (WindowClass)<>0;
End;
Function WinCreate: HWnd;
Var hWindow: HWnd;
SubMenu: hMenu;
Begin
hWindow := CreateWindow (AppName,'Test',
ws_OverlappedWindow or ws_vscroll,
cw_UseDefault,cw_UseDefault,cw_UseDefault,
cw_UseDefault,0,0,system.MainInstance,Nil);
If hWindow<>0 then begin
Menu := CreateMenu;
SubMenu := CreateMenu;
AppendMenu(Submenu,MF_STRING,101,'&Open file');
AppendMenu(Submenu,MF_STRING,102,'&Save copy');
AppendMenu(Submenu,MF_SEPARATOR,0,Nil);
AppendMenu(SubMenu,MF_String,103,'E&xit');
AppendMenu(Menu,MF_POPUP,SubMenu,'&Files');
SubMenu := CreateMenu;
AppendMenu(Menu,MF_STRING,0,'&Help');
SetMenu(hWindow,menu);
ShowWindow(hWindow,CmdShow);
ShowWindow(hWindow,SW_SHOW);
UpdateWindow(hWindow);
End;
Wincreate := hWindow;
End;
//*************** Main program ********************
Begin
If Not WinRegister Then
Begin
MessageBox (0,'Register failed',Nil, mb_Ok);
End
Else
Begin
hWindow := WinCreate;
If longint(hWindow)=0 Then
Begin
MessageBox (0,'WinCreate failed',Nil,MB_OK);
End
Else
Begin
While GetMessage(@AMessage,0,0,0) Do
Begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
End;
Halt(AMessage.wParam);
End;
End;
End.
More information about the fpc-pascal
mailing list