Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-pascal / 2002-12

mysterious error

1 message · 1 person ·

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

Hans Mårtensson

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 IOResult0 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 IOResult0 then exit;
  Len := FileSize(datafile); if IOResult0 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,@ps);
      GetClientRect(Window,@r);
      DrawText(dc,'Testprogram',-1,@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 hWindow0 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.