* working w32 rtl

rtl/win32/base.pp

@@ -105,14 +105,16 @@ unit base;
        CALTYPE = cardinal;
        CALID = cardinal;
        CCHAR = char;
+       WCHAR = word;
        COLORREF = cardinal;
        DWORD = cardinal;
+       THandle = cardinal;
 
        DWORDLONG = double;
        PDWORDLONG = ^DWORDLONG;
        FLOAT = single;
 
-       HANDLE = pointer;
+       HANDLE = THandle;
        HACCEL = HANDLE;
        HBITMAP = HANDLE;
        HBRUSH = HANDLE;
@@ -514,12 +516,7 @@ end.
 
 {
   $Log$
-  Revision 1.3  1998-05-06 12:36:50  michael
-  + Removed log from before restored version.
+  Revision 1.4  1998-06-10 10:39:11  peter
+    * working w32 rtl
 
-  Revision 1.2  1998/03/27 00:50:22  peter
-    * small fixes so it compiles
-
-  Revision 1.1.1.1  1998/03/25 11:18:46  root
-  * Restored version
 }

rtl/win32/defines.pp

@@ -37,43 +37,43 @@
 
   Unimplemented:
      /* EnumResLangProc */
-     #define RT_ACCELERATOR	(MAKEINTRESOURCE(9))
-     #define RT_BITMAP	(MAKEINTRESOURCE(2))
-     #define RT_DIALOG	(MAKEINTRESOURCE(5))
-     #define RT_FONT	(MAKEINTRESOURCE(8))
-     #define RT_FONTDIR	(MAKEINTRESOURCE(7))
-     #define RT_MENU	(MAKEINTRESOURCE(4))
-     #define RT_RCDATA	(MAKEINTRESOURCE(10))
-     #define RT_STRING	(MAKEINTRESOURCE(6))
-     #define RT_MESSAGETABLE	(MAKEINTRESOURCE(11))
-     #define RT_CURSOR	(MAKEINTRESOURCE(1))
-     #define RT_GROUP_CURSOR	(MAKEINTRESOURCE(12))
-     #define RT_ICON	(MAKEINTRESOURCE(3))
-     #define RT_GROUP_ICON	(MAKEINTRESOURCE(13))
-     #define RT_VERSION	(MAKEINTRESOURCE(16))
+     #define RT_ACCELERATOR     (MAKEINTRESOURCE(9))
+     #define RT_BITMAP  (MAKEINTRESOURCE(2))
+     #define RT_DIALOG  (MAKEINTRESOURCE(5))
+     #define RT_FONT    (MAKEINTRESOURCE(8))
+     #define RT_FONTDIR (MAKEINTRESOURCE(7))
+     #define RT_MENU    (MAKEINTRESOURCE(4))
+     #define RT_RCDATA  (MAKEINTRESOURCE(10))
+     #define RT_STRING  (MAKEINTRESOURCE(6))
+     #define RT_MESSAGETABLE    (MAKEINTRESOURCE(11))
+     #define RT_CURSOR  (MAKEINTRESOURCE(1))
+     #define RT_GROUP_CURSOR    (MAKEINTRESOURCE(12))
+     #define RT_ICON    (MAKEINTRESOURCE(3))
+     #define RT_GROUP_ICON      (MAKEINTRESOURCE(13))
+     #define RT_VERSION (MAKEINTRESOURCE(16))
 
      /* GetIconInfo */
-     #define IDC_ARROW	(MAKEINTRESOURCE(32512))
-     #define IDC_IBEAM	(MAKEINTRESOURCE(32513))
-     #define IDC_WAIT	(MAKEINTRESOURCE(32514))
-     #define IDC_CROSS	(MAKEINTRESOURCE(32515))
-     #define IDC_UPARROW	(MAKEINTRESOURCE(32516))
-     #define IDC_SIZENWSE	(MAKEINTRESOURCE(32642))
-     #define IDC_SIZENESW	(MAKEINTRESOURCE(32643))
-     #define IDC_SIZEWE	(MAKEINTRESOURCE(32644))
-     #define IDC_SIZENS	(MAKEINTRESOURCE(32645))
-     #define IDC_SIZEALL	(MAKEINTRESOURCE(32646))
-     #define IDC_NO	(MAKEINTRESOURCE(32648))
-     #define IDC_APPSTARTING	(MAKEINTRESOURCE(32650))
-     #define IDC_HELP	(MAKEINTRESOURCE(32651))
-     #define IDI_APPLICATION	(MAKEINTRESOURCE(32512))
-     #define IDI_HAND	(MAKEINTRESOURCE(32513))
-     #define IDI_QUESTION	(MAKEINTRESOURCE(32514))
-     #define IDI_EXCLAMATION	(MAKEINTRESOURCE(32515))
-     #define IDI_ASTERISK	(MAKEINTRESOURCE(32516))
-     #define IDI_WINLOGO	(MAKEINTRESOURCE(32517))
+     #define IDC_ARROW  (MAKEINTRESOURCE(32512))
+     #define IDC_IBEAM  (MAKEINTRESOURCE(32513))
+     #define IDC_WAIT   (MAKEINTRESOURCE(32514))
+     #define IDC_CROSS  (MAKEINTRESOURCE(32515))
+     #define IDC_UPARROW        (MAKEINTRESOURCE(32516))
+     #define IDC_SIZENWSE       (MAKEINTRESOURCE(32642))
+     #define IDC_SIZENESW       (MAKEINTRESOURCE(32643))
+     #define IDC_SIZEWE (MAKEINTRESOURCE(32644))
+     #define IDC_SIZENS (MAKEINTRESOURCE(32645))
+     #define IDC_SIZEALL        (MAKEINTRESOURCE(32646))
+     #define IDC_NO     (MAKEINTRESOURCE(32648))
+     #define IDC_APPSTARTING    (MAKEINTRESOURCE(32650))
+     #define IDC_HELP   (MAKEINTRESOURCE(32651))
+     #define IDI_APPLICATION    (MAKEINTRESOURCE(32512))
+     #define IDI_HAND   (MAKEINTRESOURCE(32513))
+     #define IDI_QUESTION       (MAKEINTRESOURCE(32514))
+     #define IDI_EXCLAMATION    (MAKEINTRESOURCE(32515))
+     #define IDI_ASTERISK       (MAKEINTRESOURCE(32516))
+     #define IDI_WINLOGO        (MAKEINTRESOURCE(32517))
 
-     #define VS_FILE_INFO	(MAKEINTRESOURCE(16))
+     #define VS_FILE_INFO       (MAKEINTRESOURCE(16))
      #ifdef UNICODE
      #define LPSTR_TEXTCALLBACK LPSTR_TEXTCALLBACKW
      #else
@@ -81,10 +81,10 @@
      #endif /* UNICODE */
 
      /* TV_INSERTSTRUCT structure */
-     #define TVI_ROOT	((HTREEITEM)0xFFFF0000)
-     #define TVI_FIRST	((HTREEITEM)0xFFFF0001)
-     #define TVI_LAST	((HTREEITEM)0xFFFF0002)
-     #define TVI_SORT	((HTREEITEM)0xFFFF0003)
+     #define TVI_ROOT   ((HTREEITEM)0xFFFF0000)
+     #define TVI_FIRST  ((HTREEITEM)0xFFFF0001)
+     #define TVI_LAST   ((HTREEITEM)0xFFFF0002)
+     #define TVI_SORT   ((HTREEITEM)0xFFFF0003)
 
      #ifdef UNICODE
      #define COLOROKSTRING COLOROKSTRINGW
@@ -105,7 +105,7 @@
      #endif
 
      /* MapWindowPoints */
-     #define HWND_DESKTOP	((HWND)0)
+     #define HWND_DESKTOP       ((HWND)0)
 
      #ifdef UNICODE
      #define ANIMATE_CLASS ANIMATE_CLASSW
@@ -329,8 +329,8 @@ unit defines;
        BST_PUSHED = 4;
        MF_BYCOMMAND = 0;
        MF_BYPOSITION = $400;
-       MF_CHECKED = $8;
-       MF_UNCHECKED = 0;
+//       MF_CHECKED = $8;
+//       MF_UNCHECKED = 0;
        MF_HILITE = $80;
     { ChildWindowFromPointEx }
        MF_UNHILITE = 0;
@@ -456,9 +456,6 @@ unit defines;
        SEC_IMAGE = 16777216;
        SEC_NOCACHE = 268435456;
        SEC_RESERVE = 67108864;
-       MEM_COMMIT = 4096;
-       MEM_RESERVE = 8192;
-       MEM_TOP_DOWN = 1048576;
        PAGE_EXECUTE = 16;
        PAGE_EXECUTE_READ = 32;
        PAGE_EXECUTE_READWRITE = 64;
@@ -468,6 +465,7 @@ unit defines;
        MEM_COMMIT = 4096;
        MEM_FREE = 65536;
        MEM_RESERVE = 8192;
+       MEM_TOP_DOWN = 1048576;
        MEM_IMAGE = 16777216;
        MEM_MAPPED = 262144;
        MEM_PRIVATE = 131072;
@@ -546,7 +544,7 @@ unit defines;
        LR_DEFAULTCOLOR = 0;
        LR_LOADREALSIZE = 128;
     { CreateMailslot, GetMailslotInfo }
-       LR_MONOCHROME = 1;
+//       LR_MONOCHROME = 1;
        MAILSLOT_WAIT_FOREVER = $ffffffff;
     { CreateMappedBitmap }
        MAILSLOT_NO_MESSAGE = $ffffffff;
@@ -616,16 +614,16 @@ unit defines;
        DELETE = $10000;
        READ_CONTROL = $20000;
        GENERIC_EXECUTE = $20000000;
-       SERVICE_WIN32_OWN_PROCESS = 16;
-       SERVICE_WIN32_SHARE_PROCESS = 32;
-       SERVICE_KERNEL_DRIVER = 1;
-       SERVICE_FILE_SYSTEM_DRIVER = 2;
-       SERVICE_INTERACTIVE_PROCESS = 256;
-       SERVICE_BOOT_START = 0;
-       SERVICE_SYSTEM_START = 1;
-       SERVICE_AUTO_START = 2;
-       SERVICE_DEMAND_START = 3;
-       SERVICE_DISABLED = 4;
+//       SERVICE_WIN32_OWN_PROCESS = 16;
+//       SERVICE_WIN32_SHARE_PROCESS = 32;
+//       SERVICE_KERNEL_DRIVER = 1;
+//       SERVICE_FILE_SYSTEM_DRIVER = 2;
+//       SERVICE_INTERACTIVE_PROCESS = 256;
+//       SERVICE_BOOT_START = 0;
+//       SERVICE_SYSTEM_START = 1;
+//       SERVICE_AUTO_START = 2;
+//       SERVICE_DEMAND_START = 3;
+//       SERVICE_DISABLED = 4;
        SERVICE_ERROR_IGNORE = 0;
        SERVICE_ERROR_NORMAL = 1;
        SERVICE_ERROR_SEVERE = 2;
@@ -835,7 +833,7 @@ unit defines;
        WH_MSGFILTER = -1;
        WH_SHELL = 10;
        WH_SYSMSGFILTER = 6;
-       WH_MSGFILTER = -1;
+  //     WH_MSGFILTER = -1;
     { DefineDosDevice }
        WH_FOREGROUNDIDLE = 11;
        DDD_RAW_TARGET_PATH = 1;
@@ -866,10 +864,10 @@ unit defines;
        DCTT_SUBDEV = $4;
        DC_VERSION = 10;
        DC_BINADJUST = 19;
-       DC_EMF_COMPLIANT = 20;
+//       DC_EMF_COMPLIANT = 20;
     { DeviceIoControl }
     { DlgDirList }
-       DC_DATATYPE_PRODUCED = 21;
+//       DC_DATATYPE_PRODUCED = 21;
        DDL_ARCHIVE = 32;
        DDL_DIRECTORY = 16;
        DDL_DRIVES = 16384;
@@ -1317,8 +1315,8 @@ unit defines;
        CP_MACCP = 2;
     { GetDateFormat }
        CP_OEMCP = 1;
-       DATE_SHORTDATE = 1;
-       DATE_LONGDATE = 2;
+//       DATE_SHORTDATE = 1;
+//       DATE_LONGDATE = 2;
     { GetDCEx }
        DATE_USE_ALT_CALENDAR = 4;
        DCX_WINDOW = $1;
@@ -1361,12 +1359,12 @@ unit defines;
        SIZEPALETTE = 104;
        NUMRESERVED = 106;
        COLORRES = 108;
-       PHYSICALWIDTH = 110;
-       PHYSICALHEIGHT = 111;
-       PHYSICALOFFSETX = 112;
-       PHYSICALOFFSETY = 113;
-       SCALINGFACTORX = 114;
-       SCALINGFACTORY = 115;
+//       PHYSICALWIDTH = 110;
+//       PHYSICALHEIGHT = 111;
+//       PHYSICALOFFSETX = 112;
+//       PHYSICALOFFSETY = 113;
+//       SCALINGFACTORX = 114;
+//       SCALINGFACTORY = 115;
        VREFRESH = 116;
        DESKTOPHORZRES = 118;
        DESKTOPVERTRES = 117;
@@ -1496,13 +1494,13 @@ unit defines;
        PM_REMOVE = 1;
     { GetNamedPipeHandleState }
        PM_NOYIELD = 2;
-       PIPE_NOWAIT = 1;
+//       PIPE_NOWAIT = 1;
     { GetNamedPipeInfo }
-       PIPE_READMODE_MESSAGE = 2;
+//       PIPE_READMODE_MESSAGE = 2;
        PIPE_CLIENT_END = 0;
        PIPE_SERVER_END = 1;
     { GetNextWindow, GetWindow }
-       PIPE_TYPE_MESSAGE = 4;
+//       PIPE_TYPE_MESSAGE = 4;
        GW_HWNDNEXT = 2;
        GW_HWNDPREV = 3;
        GW_CHILD = 5;
@@ -1683,9 +1681,9 @@ unit defines;
        SM_CXSMSIZE = 52;
        SM_CYSMSIZE = 53;
        SM_CXVSCROLL = 2;
-       SM_CYHSCROLL = 3;
-       SM_CXHSCROLL = 21;
-       SM_CYVSCROLL = 20;
+//       SM_CYHSCROLL = 3;
+//       SM_CXHSCROLL = 21;
+//       SM_CYVSCROLL = 20;
        SM_CYVTHUMB = 9;
        SM_CYCAPTION = 4;
        SM_CYKANJIWINDOW = 18;
@@ -1822,12 +1820,12 @@ unit defines;
        CLR_NONE = $ffffffff;
     { ImageList_LoadImage }
        CLR_DEFAULT = $ff000000;
-       LR_DEFAULTCOLOR = 0;
+//       LR_DEFAULTCOLOR = 0;
        LR_LOADFROMFILE = 16;
        LR_LOADMAP3DCOLORS = 4096;
        LR_LOADTRANSPARENT = 32;
     { ImmConfigureIME }
-       LR_MONOCHROME = 1;
+//       LR_MONOCHROME = 1;
        IME_CONFIG_GENERAL = 1;
        IME_CONFIG_REGISTERWORD = 2;
     { ImmGetConversionList }
@@ -2944,11 +2942,11 @@ unit defines;
        DM_COLLATE = $8000;
        DM_FORMNAME = $10000;
        DM_LOGPIXELS = $20000;
-       DM_BITSPERPEL = $40000;
-       DM_PELSWIDTH = $80000;
-       DM_PELSHEIGHT = $100000;
-       DM_DISPLAYFLAGS = $200000;
-       DM_DISPLAYFREQUENCY = $400000;
+//       DM_BITSPERPEL = $40000;
+//       DM_PELSWIDTH = $80000;
+//       DM_PELSHEIGHT = $100000;
+//       DM_DISPLAYFLAGS = $200000;
+//       DM_DISPLAYFREQUENCY = $400000;
        DM_ICMMETHOD = $800000;
        DM_ICMINTENT = $1000000;
        DM_MEDIATYPE = $2000000;
@@ -3125,15 +3123,15 @@ unit defines;
     { EM_FINDWORDBREAK message }
        SFF_PLAINRTF = 16384;
        WB_CLASSIFY = 3;
-       WB_ISDELIMITER = 2;
-       WB_LEFT = 0;
+//       WB_ISDELIMITER = 2;
+//       WB_LEFT = 0;
        WB_LEFTBREAK = 6;
        WB_PREVBREAK = 6;
        WB_MOVEWORDLEFT = 4;
        WB_MOVEWORDPREV = 4;
        WB_MOVEWORDRIGHT = 5;
        WB_MOVEWORDNEXT = 5;
-       WB_RIGHT = 1;
+//       WB_RIGHT = 1;
        WB_RIGHTBREAK = 7;
     { EM_GETPUNCTUATION message }
        WB_NEXTBREAK = 7;
@@ -3301,7 +3299,7 @@ unit defines;
        TTDT_RESHOW = 1;
        SBARS_SIZEGRIP = 256;
     { DL_DRAGGING message }
-       SBARS_SIZEGRIP = 256;
+//       SBARS_SIZEGRIP = 256;
        DL_MOVECURSOR = 3;
        DL_COPYCURSOR = 2;
     { Up-down control styles }
@@ -3726,7 +3724,7 @@ unit defines;
        SE_GROUP_OWNER = $8;
     { SECURITY_DESCRIPTOR_CONTROL }
        SE_GROUP_LOGON_ID = $c0000000;
-       SECURITY_DESCRIPTOR_REVISION = 1;
+//       SECURITY_DESCRIPTOR_REVISION = 1;
        SECURITY_DESCRIPTOR_MIN_LENGTH = 20;
        SE_OWNER_DEFAULTED = 1;
        SE_GROUP_DEFAULTED = 2;
@@ -4348,50 +4346,50 @@ unit defines;
        PFD_SWAP_EXCHANGE = $200;
 
     { Common control window classes }
-       ANIMATE_CLASSW	 = 'SysAnimate32';
-       HOTKEY_CLASSW	 = 'msctls_hotkey32';
-       PROGRESS_CLASSW	 = 'msctls_progress32';
-       STATUSCLASSNAMEW	 = 'msctls_statusbar32';
+       ANIMATE_CLASSW    = 'SysAnimate32';
+       HOTKEY_CLASSW     = 'msctls_hotkey32';
+       PROGRESS_CLASSW   = 'msctls_progress32';
+       STATUSCLASSNAMEW  = 'msctls_statusbar32';
        TOOLBARCLASSNAMEW = 'ToolbarWindow32';
-       TOOLTIPS_CLASSW	 = 'tooltips_class32';
-       TRACKBAR_CLASSW	 = 'msctls_trackbar32';
-       UPDOWN_CLASSW	 = 'msctls_updown32';
-       WC_HEADERW	 = 'SysHeader32';
-       WC_LISTVIEWW	 = 'SysListView32';
-       WC_TABCONTROLW	 = 'SysTabControl32';
-       WC_TREEVIEWW	 = 'SysTreeView32';
+       TOOLTIPS_CLASSW   = 'tooltips_class32';
+       TRACKBAR_CLASSW   = 'msctls_trackbar32';
+       UPDOWN_CLASSW     = 'msctls_updown32';
+       WC_HEADERW        = 'SysHeader32';
+       WC_LISTVIEWW      = 'SysListView32';
+       WC_TABCONTROLW    = 'SysTabControl32';
+       WC_TREEVIEWW      = 'SysTreeView32';
 
-       ANIMATE_CLASSA	 = 'SysAnimate32';
-       HOTKEY_CLASSA	 = 'msctls_hotkey32';
-       PROGRESS_CLASSA	 = 'msctls_progress32';
-       STATUSCLASSNAMEA	 = 'msctls_statusbar32';
+       ANIMATE_CLASSA    = 'SysAnimate32';
+       HOTKEY_CLASSA     = 'msctls_hotkey32';
+       PROGRESS_CLASSA   = 'msctls_progress32';
+       STATUSCLASSNAMEA  = 'msctls_statusbar32';
        TOOLBARCLASSNAMEA = 'ToolbarWindow32';
-       TOOLTIPS_CLASSA	 = 'tooltips_class32';
-       TRACKBAR_CLASSA	 = 'msctls_trackbar32';
-       UPDOWN_CLASSA	 = 'msctls_updown32';
-       WC_HEADERA	 = 'SysHeader32';
-       WC_LISTVIEWA	 = 'SysListView32';
-       WC_TABCONTROLA	 = 'SysTabControl32';
-       WC_TREEVIEWA	 = 'SysTreeView32';
+       TOOLTIPS_CLASSA   = 'tooltips_class32';
+       TRACKBAR_CLASSA   = 'msctls_trackbar32';
+       UPDOWN_CLASSA     = 'msctls_updown32';
+       WC_HEADERA        = 'SysHeader32';
+       WC_LISTVIEWA      = 'SysListView32';
+       WC_TABCONTROLA    = 'SysTabControl32';
+       WC_TREEVIEWA      = 'SysTreeView32';
 
     { Common dialog messages }
-       COLOROKSTRINGW	 = 'commdlg_ColorOK';
-       FILEOKSTRINGW	 = 'commdlg_FileNameOK';
-       FINDMSGSTRINGW	 = 'commdlg_FindReplace';
-       HELPMSGSTRINGW	 = 'commdlg_help';
-       LBSELCHSTRINGW	 = 'commdlg_LBSelChangedNotify';
-       SETRGBSTRINGW	 = 'commdlg_SetRGBColor';
-       SHAREVISTRINGW	 = 'commdlg_ShareViolation';
-       COLOROKSTRINGA	 = 'commdlg_ColorOK';
-       FILEOKSTRINGA	 = 'commdlg_FileNameOK';
-       FINDMSGSTRINGA	 = 'commdlg_FindReplace';
-       HELPMSGSTRINGA	 = 'commdlg_help';
-       LBSELCHSTRINGA	 = 'commdlg_LBSelChangedNotify';
-       SETRGBSTRINGA	 = 'commdlg_SetRGBColor';
-       SHAREVISTRINGA	 = 'commdlg_ShareViolation';
+       COLOROKSTRINGW    = 'commdlg_ColorOK';
+       FILEOKSTRINGW     = 'commdlg_FileNameOK';
+       FINDMSGSTRINGW    = 'commdlg_FindReplace';
+       HELPMSGSTRINGW    = 'commdlg_help';
+       LBSELCHSTRINGW    = 'commdlg_LBSelChangedNotify';
+       SETRGBSTRINGW     = 'commdlg_SetRGBColor';
+       SHAREVISTRINGW    = 'commdlg_ShareViolation';
+       COLOROKSTRINGA    = 'commdlg_ColorOK';
+       FILEOKSTRINGA     = 'commdlg_FileNameOK';
+       FINDMSGSTRINGA    = 'commdlg_FindReplace';
+       HELPMSGSTRINGA    = 'commdlg_help';
+       LBSELCHSTRINGA    = 'commdlg_LBSelChangedNotify';
+       SETRGBSTRINGA     = 'commdlg_SetRGBColor';
+       SHAREVISTRINGA    = 'commdlg_ShareViolation';
 
        UNICODE_NULL : WCHAR = 0;
-       INVALID_HANDLE_VALUE : HANDLE = -1;
+       INVALID_HANDLE_VALUE : THANDLE = -1;
        { PostMessage }
        HWND_BROADCAST : HWND = $FFFF;
        { RegCreateKey }
@@ -4404,13 +4402,13 @@ unit defines;
 
        HWND_BOTTOM : HWND = 1;
        HWND_NOTOPMOST : HWND = -2;
-       HWND_TOP	: HWND = 0;
+       HWND_TOP : HWND = 0;
        HWND_TOPMOST : HWND = -1;
 
        HINST_COMMCTRL : HINSTANCE = -1;
 
-       LPSTR_TEXTCALLBACKW : LPWSTR = -1;
-       LPSTR_TEXTCALLBACKA : LPSTR = -1;
+       LPSTR_TEXTCALLBACKW : LPWSTR = nil;
+       LPSTR_TEXTCALLBACKA : LPSTR = nil;
 
   implementation
 
@@ -4418,9 +4416,7 @@ end.
 
 {
   $Log$
-  Revision 1.2  1998-05-06 12:36:50  michael
-  + Removed log from before restored version.
+  Revision 1.3  1998-06-10 10:39:12  peter
+    * working w32 rtl
 
-  Revision 1.1.1.1  1998/03/25 11:18:46  root
-  * Restored version
 }

rtl/win32/dos.pp

@@ -19,7 +19,12 @@ unit dos;
 
 interface
 
+{ Include Win32 Consts,Types }
+{$I win32.inc}
+
 Const
+  Max_Path = 255;
+
   {Bitmasks for CPU Flags}
   fcarry     = $0001;
   fparity    = $0004;
@@ -70,13 +75,30 @@ Type
     Sec   : word;
   End;
 
-  searchrec = packed record
-     time : longint;
-     size : longint;
-     attr : longint;
-     name : string;
+  PWin32FindData = ^TWin32FindData;
+  TWin32FindData = packed record
+    dwFileAttributes: Cardinal;
+    ftCreationTime: TFileTime;
+    ftLastAccessTime: TFileTime;
+    ftLastWriteTime: TFileTime;
+    nFileSizeHigh: Cardinal;
+    nFileSizeLow: Cardinal;
+    dwReserved0: Cardinal;
+    dwReserved1: Cardinal;
+    cFileName: array[0..MAX_PATH - 1] of Char;
+    cAlternateFileName: array[0..13] of Char;
   end;
 
+  Searchrec = Packed Record
+    FindHandle  : THandle;
+    W32FindData : TWin32FindData;
+    time : longint;
+    size : longint;
+    attr : longint;
+    name : string;
+  end;
+
+
   registers = packed record
     case i : integer of
      0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
@@ -140,7 +162,61 @@ Procedure Keep(exitcode: word);
 implementation
 uses strings;
 
-{$I win32.inc}
+{******************************************************************************
+                           --- Conversion ---
+******************************************************************************}
+
+   function GetLastError : DWORD;
+     external 'kernel32' name 'GetLastError';
+   function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : boolean;
+     external 'kernel32' name 'FileTimeToDosDateTime';
+   function DosDateTimeToFileTime(date,time : word;var ft :TFileTime) : boolean;
+     external 'kernel32' name 'DosDateTimeToFileTime';
+   function FileTimeToLocalFileTime(const ft : TFileTime;var lft : TFileTime) : boolean;
+     external 'kernel32' name 'FileTimeToLocalFileTime';
+   function LocalFileTimeToFileTime(const lft : TFileTime;var ft : TFileTime) : boolean;
+     external 'kernel32' name 'LocalFileTimeToFileTime';
+
+type
+  Longrec=packed record
+    lo,hi : word;
+  end;
+
+function Last2DosError(d:dword):integer;
+begin
+  Last2DosError:=d;
+end;
+
+
+Function DosToWinAttr (Const Attr : Longint) : longint;
+begin
+  DosToWinAttr:=Attr;
+end;
+
+
+Function WinToDosAttr (Const Attr : Longint) : longint;
+begin
+  WinToDosAttr:=Attr;
+end;
+
+
+Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):boolean;
+var
+  lft : TFileTime;
+begin
+  DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
+                LocalFileTimeToFileTime(lft,Wtime);
+end;
+
+
+Function WinToDosTime (Const Wtime : TFileTime;var DTime:longint):boolean;
+var
+  lft : TFileTime;
+begin
+  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
+                FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
+end;
+
 
 {******************************************************************************
                            --- Dos Interrupt ---
@@ -153,7 +229,7 @@ end;
 
 procedure msdos(var regs : registers);
 begin
-  intr($21,regs);
+  { !!!!!!!! }
 end;
 
 
@@ -161,6 +237,13 @@ end;
                         --- Info / Date / Time ---
 ******************************************************************************}
 
+   function GetVersion : longint;
+     external 'kernel32' name 'GetVersion';
+   procedure GetLocalTime(var t : TSystemTime);
+     external 'kernel32' name 'GetLocalTime';
+   function SetLocalTime(const t : TSystemTime) : boolean;
+     external 'kernel32' name 'SetLocalTime';
+
 function dosversion : word;
 begin
   dosversion:=GetVersion;
@@ -169,7 +252,7 @@ end;
 
 procedure getdate(var year,month,mday,wday : word);
 var
-  t : SYSTEMTIME;
+  t : TSystemTime;
 begin
   GetLocalTime(t);
   year:=t.wYear;
@@ -181,7 +264,7 @@ end;
 
 procedure setdate(year,month,day : word);
 var
-  t : SYSTEMTIME;
+  t : TSystemTime;
 begin
   { we need the time set privilege   }
   { so this function crash currently }
@@ -197,7 +280,7 @@ end;
 
 procedure gettime(var hour,minute,second,sec100 : word);
 var
-  t : SYSTEMTIME;
+  t : TSystemTime;
 begin
    GetLocalTime(t);
    hour:=t.wHour;
@@ -209,7 +292,7 @@ end;
 
 procedure settime(hour,minute,second,sec100 : word);
 var
-   t : SYSTEMTIME;
+   t : TSystemTime;
 begin
    { we need the time set privilege   }
    { so this function crash currently }
@@ -247,12 +330,53 @@ End;
                                --- Exec ---
 ******************************************************************************}
 
+   function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
+               lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
+               bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
+               lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
+               var lpProcessInformation: TProcessInformation): boolean;
+     external 'kernel32' name 'CreateProcessA';
+   function getExitCodeProcess(h:THandle;var code:longint):boolean;
+     external 'kernel32' name 'GetExitCodeProcess';
+   function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
+     external 'kernel32' name 'WaitForSingleObject';
+   function CloseHandle(h : THandle) : longint;
+     external 'kernel32' name 'CloseHandle';
+
 var
   lastdosexitcode : word;
 
 procedure exec(const path : pathstr;const comline : comstr);
+var
+  SI: TStartupInfo;
+  PI: TProcessInformation;
+  Proc : THandle;
+  l    : Longint;
+  AppPath,
+  AppParam : array[0..255] of char;
 begin
-  { !!!!!!!! }
+  FillChar(SI, SizeOf(SI), 0);
+  SI.cb:=SizeOf(SI);
+  SI.wShowWindow:=1;
+  Move(Path[1],AppPath,length(Path));
+  AppPath[Length(Path)]:=#0;
+  AppParam[0]:='-';
+  AppParam[1]:=' ';
+  Move(ComLine[1],AppParam[2],length(Comline));
+  AppParam[Length(ComLine)+2]:=#0;
+  if not CreateProcess(PChar(@AppPath), PChar(@AppParam), Nil, Nil, False,$20, Nil, Nil, SI, PI) then
+   begin
+     DosError:=Last2DosError(GetLastError);
+     exit;
+   end;
+  Proc:=PI.hProcess;
+  CloseHandle(PI.hThread);
+  if WaitForSingleObject(Proc, Infinite) <> $ffffffff then
+    GetExitCodeProcess(Proc,l)
+  else
+    l:=-1;
+  CloseHandle(Proc);
+  LastDosExitCode:=l;
 end;
 
 
@@ -290,17 +414,57 @@ end;
                                --- Disk ---
 ******************************************************************************}
 
+   function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
+                             freeclusters,totalclusters:longint):boolean;
+     external 'kernel32' name 'GetDiskFreeSpaceA';
+
 function diskfree(drive : byte) : longint;
+var
+  disk : array[1..4] of char;
+  secs,bytes,
+  free,total : longint;
 begin
-{ !!!!!!!!! }
-  diskfree:=-1;
+  if drive=0 then
+   begin
+     disk[1]:='\';
+     disk[2]:=#0;
+   end
+  else
+   begin
+     disk[1]:=chr(drive+64);
+     disk[2]:=':';
+     disk[3]:='\';
+     disk[4]:=#0;
+   end;
+  if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+   diskfree:=free*secs*bytes
+  else
+   diskfree:=-1;
 end;
 
 
 function disksize(drive : byte) : longint;
+var
+  disk : array[1..4] of char;
+  secs,bytes,
+  free,total : longint;
 begin
-{ !!!!!!!!! }
-  disksize:=-1;
+  if drive=0 then
+   begin
+     disk[1]:='\';
+     disk[2]:=#0;
+   end
+  else
+   begin
+     disk[1]:=chr(drive+64);
+     disk[2]:=':';
+     disk[3]:='\';
+     disk[4]:=#0;
+   end;
+  if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+   disksize:=total*secs*bytes
+  else
+   disksize:=-1;
 end;
 
 
@@ -308,77 +472,104 @@ end;
                          --- Findfirst FindNext ---
 ******************************************************************************}
 
-    procedure searchrec2dossearchrec(var f : searchrec);
-      var
-         l,i : longint;
-      begin
-         l:=length(f.name);
-         for i:=1 to 12 do
-           f.name[i-1]:=f.name[i];
-         f.name[l]:=#0;
-      end;
+{ Needed kernel calls }
 
-    procedure dossearchrec2searchrec(var f : searchrec);
-      var
-         l,i : longint;
-      begin
-         l:=12;
-         for i:=0 to 12 do
-           if f.name[i]=#0 then
-             begin
-                l:=i;
-                break;
-             end;
-         for i:=11 downto 0 do
-           f.name[i+1]:=f.name[i];
-         f.name[0]:=chr(l);
-      end;
+   function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;
+     external 'kernel32' name 'FindFirstFileA';
+   function FindNextFile  (hFindFile: THandle; var lpFindFileData: TWIN32FindData): Boolean;
+     external 'kernel32' name 'FindNextFileA';
+   function FindCloseFile (hFindFile: THandle): Boolean;
+     external 'kernel32' name 'FindClose';
 
-    procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+Procedure StringToPchar (Var S : String);
+Var L : Longint;
+begin
+  L:=ord(S[0]);
+  Move (S[1],S[0],L);
+  S[L]:=#0;
+end;
 
-      procedure _findfirst(path : pchar;attr : word;var f : searchrec);
-        begin
-          {!!!!!!!!!!!!!!}
-        end;
 
-      var
-         path0 : array[0..80] of char;
+procedure FindMatch(var f:searchrec);
+Var
+  TheAttr : Longint;
+begin
+  TheAttr:=DosToWinAttr(F.Attr);
+{ Find file with correct attribute }
+  While (F.W32FindData.dwFileAttributes and TheAttr)=0 do
+   begin
+     if not FindNextFile (F.FindHandle,F.W32FindData) then
       begin
-         { no error }
-         doserror:=0;
-         strpcopy(path0,path);
-         _findfirst(path0,attr,f);
-         dossearchrec2searchrec(f);
+        DosError:=Last2DosError(GetLastError);
+        exit;
       end;
+   end;
+{ Convert some attributes back }
+  f.size:=F.W32FindData.NFileSizeLow;
+  f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
+  WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
+  f.Name:=StrPas(@F.W32FindData.cFileName);
+end;
 
-    procedure findnext(var f : searchRec);
 
-      procedure _findnext(var f : searchrec);
-        begin
-          {!!!!!!!!!!!!!!}
-        end;
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+begin
+{ no error }
+  doserror:=0;
+  F.Name:=Path;
+  F.Attr:=attr;
+  StringToPchar(f.name);
+{ FindFirstFile is a Win32 Call. }
+  F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData);
+  If longint(F.FindHandle)=Invalid_Handle_value then
+   begin
+     DosError:=Last2DosError(GetLastError);
+     exit;
+   end;
+{ Find file with correct attribute }
+  FindMatch(f);
+end;
 
-      begin
-         { no error }
-         doserror:=0;
-         searchrec2dossearchrec(f);
-         _findnext(f);
-         dossearchrec2searchrec(f);
-      end;
 
-    procedure swapvectors;
-      begin
-      end;
+procedure findnext(var f : searchRec);
+begin
+{ no error }
+  doserror:=0;
+  if not FindNextFile (F.FindHandle,F.W32FindData) then
+   begin
+     DosError:=Last2DosError(GetLastError);
+     exit;
+   end;
+{ Find file with correct attribute }
+  FindMatch(f);
+end;
 
 
-    Procedure FindClose(Var f: SearchRec);
-      begin
-      end;
+procedure swapvectors;
+begin
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+  If longint(F.FindHandle)<>Invalid_Handle_value then
+   FindCloseFile(F.FindHandle);
+end;
+
 
 {******************************************************************************
                                --- File ---
 ******************************************************************************}
 
+   function GetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;
+     external 'kernel32' name 'GetFileTime';
+   function SetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;
+     external 'kernel32' name 'SetFileTime';
+   function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : boolean;
+     external 'kernel32' name 'SetFileAttributesA';
+   function GetFileAttributes(lpFileName : pchar) : longint;
+     external 'kernel32' name 'GetFileAttributesA';
+
 procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
 var
    p1,i : longint;
@@ -431,13 +622,13 @@ begin
      pa[i]:='\';
    if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then
      begin
-        { we must get the right directory }
-        getdir(ord(pa[1])-ord('A')+1,s);
-        if (ord(pa[0])>2) and (pa[3]<>'\') then
-          if pa[1]=s[1] then
-            pa:=s+'\'+copy (pa,3,length(pa))
-          else
-            pa:=pa[1]+':\'+copy (pa,3,length(pa))
+       { we must get the right directory }
+       getdir(ord(pa[1])-ord('A')+1,s);
+       if (ord(pa[0])>2) and (pa[3]<>'\') then
+         if pa[1]=s[1] then
+           pa:=s+'\'+copy (pa,3,length(pa))
+         else
+           pa:=pa[1]+':\'+copy (pa,3,length(pa))
      end
    else
      if pa[1]='\' then
@@ -509,25 +700,23 @@ end;
 
 
 procedure getftime(var f;var time : longint);
-type
-   lr = record
-      lo,hi : word;
-   end;
 var
-   ft,lft : FILETIME;
+   ft : TFileTime;
 begin
-   if GetFileTime(filerec(f).handle,nil,nil,@ft) and
-      FileTimeToLocalFileTime(ft,lft) and
-      FileTimeToDosDateTime(lft,lr(time).hi,lr(time).lo) then
-     exit
-   else
-     time:=0;
+  if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
+     WinToDosTime(ft,time) then
+    exit
+  else
+    time:=0;
 end;
 
 
 procedure setftime(var f;time : longint);
+var
+  ft : TFileTime;
 begin
-   { !!!!!!!!!!!!! }
+  if DosToWinTime(time,ft) then
+   SetFileTime(filerec(f).Handle,nil,nil,@ft);
 end;
 
 
@@ -559,6 +748,11 @@ end;
   terminated by a #0
 }
 
+   function GetEnvironmentStrings : pchar;
+     external 'kernel32' name 'GetEnvironmentStringsA';
+   function FreeEnvironmentStrings(p : pchar) : boolean;
+     external 'kernel32' name 'FreeEnvironmentStringsA';
+
 function envcount : longint;
 var
    hp,p : pchar;
@@ -649,7 +843,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.6  1998-06-08 23:07:45  peter
+  Revision 1.7  1998-06-10 10:39:13  peter
+    * working w32 rtl
+
+  Revision 1.6  1998/06/08 23:07:45  peter
     * dos interface is now 100% compatible
     * fixed call PASCALMAIN which must be direct asm
 

rtl/win32/makefile

@@ -3,7 +3,7 @@
 #   This file is part of the Free Pascal run time library.
 #   Copyright (c) 1996-98 by Michael van Canneyt
 #
-#   Makefile for the Free Pascal Go32v1 Runtime Library
+#   Makefile for the Free Pascal Win32 Runtime Library
 #
 #   See the file COPYING.FPC, included in this distribution,
 #   for details about the copyright.
@@ -21,24 +21,14 @@
 # with the main makefile.
 #####################################################################
 
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=c:\lib\ppc\win32
-endif
-
-# set the directory where to install libraries
-ifndef LIBINSTALLDIR
-LIBINSTALLDIR=c:\lib
-endif
-
-# What is the Operating System
-ifndef OS_SRC
-OS_SRC=GO32V2
+# What is the Operating System ?
+ifndef OS_SOURCE
+OS_SOURCE=win32
 endif
 
 # What is the target operating system ?
 ifndef OS_TARGET
-OS_TARGET=WIN32
+OS_TARGET=win32
 endif
 
 # What is the target processor :
@@ -48,7 +38,6 @@ CPU=i386
 endif
 
 # What compiler to use ?
-# I think ppc386 is better (it's mostly in path) (FK)
 ifndef PP
 PP=ppc386
 endif
@@ -59,11 +48,24 @@ ifndef OPT
 OPT=
 endif
 
-# Where is the ppumove program ?
+# Where is the PPUMOVE program ?
 ifndef PPUMOVE
 PPUMOVE=ppumove
 endif
 
+# Set this to 'shared' or 'static'
+LIBTYPE=shared
+
+# AOUT should be defined in main makefile.
+# But you can set it here too.
+# AOUT = -DAOUT
+
+# Do you want to link to the C library ?
+# Standard it is NO. You can set it to YES to link in th C library.
+ifndef LINK_TO_C
+LINK_TO_C=NO
+endif
+
 #####################################################################
 # End of configurable section.
 # Do not edit after this line.
@@ -88,13 +90,13 @@ OBJPASDIR=../objpas
 include $(CFG)/makefile.cfg
 
 # Get the system independent include file names.
-# This will set the following variables : 
+# This will set the following variables :
 # SYSINCNAMES
 include $(INC)/makefile.inc
 SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 
 # Get the processor dependent include file names.
-# This will set the following variables : 
+# This will set the following variables :
 # CPUINCNAMES
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
@@ -106,27 +108,15 @@ SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 # System dependent
 #####################################################################
 
-# Determine needed extensions
 PPUEXT=.ppw
-PPLEXT=.ppl
-OEXT=.obj
-ASMEXT=.s
-LIBEXT=.a
 
-# Define Windows Units
+# Define Linux Units
 SYSTEMPPU=syswin32$(PPUEXT)
 OBJECTS=strings objpas \
-	base \
 	dos \
-# crt objects printer \
-	cpu mmx getopts \
-
-# No loaders needed
-LOADERS=
-
+        base messages defines
 
 # Add Prefix and Suffixes
-OBJLOADERS=$(addsuffix $(OEXT), $(LOADERS))
 PPUOBJECTS=$(addsuffix $(PPUEXT), $(OBJECTS))
 
 .PHONY : all install clean \
@@ -140,26 +130,22 @@ install : all
 	$(INSTALL) *$(PPUEXT) *$(OEXT) $(UNITINSTALLDIR)
 
 clean :
-	-$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) *.PPS log
+	-$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) log
 
 #####################################################################
 # Files
 #####################################################################
 
-#
-# Loaders
-#
-
 #
 # Base Units (System, strings, os-dependent-base-unit)
 #
 
-$(SYSTEMPPU) : syswin32.pp $(SYSDEPS) win32.inc
+$(SYSTEMPPU) : syswin32.pp win32.inc $(SYSDEPS)
 	$(PP) $(OPT) -Us -Sg syswin32.pp $(REDIR)
 
 strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU)
 	$(COPY) $(PROCINC)/strings.pp .
-	$(PP) $(OPT) strings.pp $(REDIR)
+	$(PP) $(OPT) strings $(REDIR)
 	$(DEL) strings.pp
 
 #
@@ -178,77 +164,50 @@ objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp $(SYSTEMPPU)
 base$(PPUEXT) : base.pp $(SYSTEMPPU)
 	$(PP) $(OPT) base.pp $(REDIR)
 
+messages$(PPUEXT) : messages.pp $(SYSTEMPPU)
+	$(PP) $(OPT) messages.pp $(REDIR)
+
+defines$(PPUEXT) : defines.pp $(SYSTEMPPU)
+	$(PP) $(OPT) defines.pp $(REDIR)
+
 #
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
-	strings$(PPUEXT) $(SYSTEMPPU) win32.inc
+dos$(PPUEXT) : $(DOSDEPS) $(INC)/filerec.inc $(INC)/textrec.inc $(SYSTEMPPU)
 	$(PP) $(OPT) dos $(REDIR)
 
-#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
-#	 $(PP) $(OPT) crt $(REDIR)
-
-#objects$(PPUEXT) : objects.pp $(SYSTEMPPU)
-#	 $(PP) $(OPT) objects.pp $(REDIR)
-
-#printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
-#	 $(PP) $(OPT) printer.pp $(REDIR)
+#objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+#	 $(COPY) $(INC)/objects.pp .
+#	 $(PP) $(OPT) objects $(REDIR)
+#	 $(DEL) objects.pp
 
 #
 # Other RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/cpu.pp .
-	$(PP) $(OPT) cpu.pp $(REDIR)
-	$(DEL) cpu.pp
-
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/mmx.pp .
-	$(PP) $(OPT) mmx.pp $(REDIR)
-	$(DEL) mmx.pp
-
-getopts$(PPUEXT) : $(PROCINC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/getopts.pp .
-	$(PP) $(OPT) getopts.pp $(REDIR)
-	$(DEL) getopts.pp
-
-
 #####################################################################
 # Libs
 #####################################################################
 
-libs: all
-
-libsclean : clean
-	-$(DEL) *.$(LIBEXT) *$(PPLEXT)
-
-#####################################################################
-# Diffs
-#####################################################################
-
-%.dif : %.pp
-	-$(DIFF) $(DIFFOPTS) $*.pp $(REFPATH)/dos/go32v1/$*.pp > $*.dif
-
-%.dif : %.inc
-	-$(DIFF) $(DIFFOPTS) $*.inc $(REFPATH)/dos/go32v1/$*.inc > $*.dif
+libs	: all libfpc$(LIBEXT)
 
-%.dif : %.as
-	-$(DIFF) $(DIFFOPTS) $*.as $(REFPATH)/dos/go32v1/$*.as > $*.dif
+libfpc.so:
+	$(PPUMOVE) -o fpc *.ppu
 
-diffclean:
-	-$(DEL) *.dif
+libfpc.a:
+	$(PPUMOVE) -s -o fpc *.ppu
 
-makefile.dif : makefile
-	-$(DIFF) $(DIFFOPTS) makefile $(REFPATH)/dos/go32v1/makefile > makefile.dif
+libinstall : libs
+	$(INSTALLEXE) libfpc$(LIBEXT) $(LIBINSTALLDIR)
+	$(INSTALL) *$(PPLEXT) $(UNITINSTALLDIR)
+	ldconfig
 
-diffs: syswin32.dif os.dif makefile.dif dos.dif base.dif struct.dif \
-       winheap.dif messages.dif
+libsclean : clean
+	-$(DEL) *.a *.so *$(PPLEXT)
 
 #####################################################################
-# Distribution
+# Default targets
 #####################################################################
 
-distclean : clean libsclean diffclean
-
+include $(CFG)/makefile.def

rtl/win32/messages.pp

@@ -244,7 +244,7 @@ unit messages;
        HDM_GETITEM = HDM_GETITEMA;
        HDM_INSERTITEM = HDM_INSERTITEMA;
        HDM_SETITEM = HDM_SETITEMA;
-{$endifUNICODE}
+{$endif UNICODE}
        HDM_GETITEMCOUNT = 4608;
        HDM_HITTEST = 4614;
     { Header control notifications }
@@ -371,6 +371,8 @@ unit messages;
        LVM_INSERTCOLUMNA = 4123;
        LVM_INSERTITEMA = 4103;
        LVM_SETCOLUMNA = 4122;
+       LVM_SETITEMA = 4102;
+       LVM_SETITEMTEXTA = 4242;
 {$ifdef UNICODE}
        LVM_SETITEMA = 4102;
        LVM_SETITEMTEXTA = 4142;
@@ -1048,9 +1050,7 @@ end.
 
 {
   $Log$
-  Revision 1.2  1998-05-06 12:36:50  michael
-  + Removed log from before restored version.
+  Revision 1.3  1998-06-10 10:39:15  peter
+    * working w32 rtl
 
-  Revision 1.1.1.1  1998/03/25 11:18:46  root
-  * Restored version
 }

rtl/win32/os.inc

@@ -13,16 +13,14 @@
  **********************************************************************}
 
 {$define win32}
+{$undef go32v1}
 {$undef go32v2}
 {$undef os2}
 {$undef linux}
-{$undef dos}
 
 {
   $Log$
-  Revision 1.2  1998-05-06 12:37:22  michael
-  + Removed log from before restored version.
+  Revision 1.3  1998-06-10 10:39:16  peter
+    * working w32 rtl
 
-  Revision 1.1.1.1  1998/03/25 11:18:47  root
-  * Restored version
 }

rtl/win32/syswin32.pp

@@ -1,11 +1,11 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    FPC Pascal system unit for the Win32 API.
-
     Copyright (c) 1993-98 by Florian Klaempfl and Pavel Ozerski
     member of the Free Pascal development team.
 
+    FPC Pascal system unit for the Win32 API.
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -14,245 +14,309 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$S-}
 unit syswin32;
 
 {$I os.inc}
 
-  interface
+interface
+
+{ include system-independent routine headers }
+
+{$I systemh.inc}
+
+const
+{ Default filehandles }
+   UnusedHandle    : longint = -1;
+   StdInputHandle  : longint = 0;
+   StdOutputHandle : longint = 0;
+   StdErrorHandle  : longint = 0;
+
+type
+  TStartupInfo=packed record
+    cb : longint;
+    lpReserved : Pointer;
+    lpDesktop : Pointer;
+    lpTitle : Pointer;
+    dwX : longint;
+    dwY : longint;
+    dwXSize : longint;
+    dwYSize : longint;
+    dwXCountChars : longint;
+    dwYCountChars : longint;
+    dwFillAttribute : longint;
+    dwFlags : longint;
+    wShowWindow : Word;
+    cbReserved2 : Word;
+    lpReserved2 : Pointer;
+    hStdInput : longint;
+    hStdOutput : longint;
+    hStdError : longint;
+  end;
+
+var
+  startupinfo : tstartupinfo;
+  hprevinst,
+  hinstance,
+  cmdshow     : longint;
+  heaperror   : pointer;
 
-    {$I systemh.inc}
+implementation
 
-    var
-       hprevinst,hinstance,cmdshow : longint;
-       heaperror : pointer;
+{ include system independent routines }
 
-    { $I heaph.inc}
+{$I system.inc}
 
-    const
-       UnusedHandle    : longint = -1;
-       StdInputHandle  : longint = 0;
-       StdOutputHandle : longint = 0;
-       StdErrorHandle  : longint = 0;
+{ some declarations for Win32 API calls }
+{$I win32.inc}
 
-  implementation
+type
+  plongint = ^longint;
 
-    { some declarations for Win32 API calls }
-    {$I Win32.inc}
-    {$I system.inc}
+   { misc. functions }
+   function GetLastError : DWORD;
+     external 'kernel32' name 'GetLastError';
+   function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
+     external 'user32' name 'MessageBoxA';
 
-    type
-       plongint = ^longint;
+   { command line/enviroment functions }
+   function GetCommandLine : LPTSTR;
+     external 'kernel32' name 'GetCommandLineA';
+   { time and date functions }
+   function GetTickCount : longint;
+     external 'kernel32' name 'GetTickCount';
+   { process functions }
+   procedure ExitProcess(uExitCode : UINT);
+     external 'kernel32' name 'ExitProcess';
 
-{$ifdef dummy}
-{$S-}
-    procedure st1(stack_size : longint);[public,alias: 'STACKCHECK'];
 
-      begin
-         { called when trying to get local stack }
-         { if the compiler directive $S is set   }
-         { this function must preserve esi !!!!  }
-         { because esi is set by the calling     }
-         { proc for methods                      }
-         { it must preserve all registers !!     }
-
-         asm
-            pushl %eax
-            pushl %ebx
-            movl stack_size,%ebx
-            movl %esp,%eax
-            subl %ebx,%eax
+{$ifdef dummy}
+procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
+{
+  called when trying to get local stack if the compiler directive $S
+  is set this function must preserve esi !!!! because esi is set by
+  the calling proc for methods it must preserve all registers !!
+}
+begin
+  asm
+        pushl   %eax
+        pushl   %ebx
+        movl    stack_size,%ebx
+        movl    %esp,%eax
+        subl    %ebx,%eax
 {$ifdef SYSTEMDEBUG}
-            movl U_SYSTEM_LOWESTSTACK,%ebx
-            cmpl %eax,%ebx
-            jb   _is_not_lowest
-            movl %eax,U_SYSTEM_LOWESTSTACK
-            _is_not_lowest:
+        movl    U_SYSTEM_LOWESTSTACK,%ebx
+        cmpl    %eax,%ebx
+        jb      _is_not_lowest
+        movl    %eax,U_SYSTEM_LOWESTSTACK
+_is_not_lowest:
 {$endif SYSTEMDEBUG}
-            movl __stkbottom,%ebx
-            cmpl %eax,%ebx
-            jae  __short_on_stack
-            popl %ebx
-            popl %eax
-            leave
-            ret  $4
-            __short_on_stack:
-            { can be usefull for error recovery !! }
-            popl %ebx
-            popl %eax
-         end['EAX','EBX'];
-         RunError(202);
-         { this needs a local variable }
-         { so the function called itself !! }
-         { Writeln('low in stack ');
-         RunError(202);             }
-      end;
+        movl    __stkbottom,%ebx
+        cmpl    %eax,%ebx
+        jae     __short_on_stack
+        popl    %ebx
+        popl    %eax
+        leave
+        ret     $4
+__short_on_stack:
+        { can be usefull for error recovery !! }
+        popl    %ebx
+        popl    %eax
+  end['EAX','EBX'];
+  RunError(202);
+end;
 {$endif dummy}
 
-    procedure halt(errnum : byte);
 
-      begin
-         do_exit;
-         flush(stderr);
-         ExitProcess(errnum);
-      end;
+procedure halt(errnum : byte);
+begin
+  do_exit;
+  flush(stderr);
+  ExitProcess(errnum);
+end;
 
-    function paramcount : longint;
 
-      var
-         count : longint;
-         cmdline : pchar;
-         quote : set of char;
+function paramcount : longint;
+var
+  count   : longint;
+  cmdline : pchar;
+  quote   : set of char;
+begin
+  cmdline:=GetCommandLine;
+  count:=0;
+  while true do
+   begin
+     { skip leading spaces }
+     while cmdline^ in [' ',#9] do
+       cmdline:=cmdline+1;
+     if cmdline^='"' then
+       begin
+          quote:=['"'];
+          cmdline:=cmdline+1;
+       end
+     else
+       quote:=[' ',#9];
+     if cmdline^=#0 then
+       break;
+     inc(count);
+     while (cmdline^<>#0) and not(cmdline^ in quote) do
+       cmdline:=cmdline+1;
+     { skip quote }
+     if cmdline^ in quote then
+       cmdline:=cmdline+1;
+   end;
+  paramcount:=count-1;
+end;
 
-      begin
-         cmdline:=GetCommandLine;
-         count:=0;
-         while true do
-           begin
-              { skip leading spaces }
-              while cmdline^ in [' ',#9] do
-                cmdline:=cmdline+1;
-              if cmdline^='"' then
-                begin
-                   quote:=['"'];
+
+function paramstr(l : longint) : string;
+var
+  s       : string;
+  count   : longint;
+  cmdline : pchar;
+  quote   : set of char;
+begin
+  s:='';
+  if (l>=0) and (l<=paramcount) then
+    begin
+       cmdline:=GetCommandLine;
+       count:=0;
+       while true do
+         begin
+            { skip leading spaces }
+            while cmdline^ in [' ',#9] do
+              cmdline:=cmdline+1;
+            if cmdline^='"' then
+              begin
+                 quote:=['"'];
+                 cmdline:=cmdline+1;
+              end
+            else
+              quote:=[' ',#9];
+            if cmdline^=#0 then
+              break;
+            if count=l then
+              begin
+                 while (cmdline^<>#0) and not(cmdline^ in quote) do
+                   begin
+                      s:=s+cmdline^;
+                      cmdline:=cmdline+1;
+                   end;
+                 break;
+              end
+            else
+              begin
+                 while (cmdline^<>#0) and not(cmdline^ in quote) do
                    cmdline:=cmdline+1;
-                end
-              else
-                quote:=[' ',#9];
-              if cmdline^=#0 then
-                break;
-              inc(count);
-              while (cmdline^<>#0) and not(cmdline^ in quote) do
-                cmdline:=cmdline+1;
-              { skip quote }
-              if cmdline^ in quote then
-                cmdline:=cmdline+1;
-           end;
-         paramcount:=count-1;
-      end;
+              end;
+            { skip quote }
+            if cmdline^ in quote then
+              cmdline:=cmdline+1;
+            inc(count);
+         end;
 
-    function paramstr(l : longint) : string;
+    end;
+  paramstr:=s;
+end;
 
-      var
-         s : string;
-         count : longint;
-         cmdline : pchar;
-         quote : set of char;
 
-      begin
-         s:='';
-         if (l>=0) and (l<=paramcount) then
-           begin
-              cmdline:=GetCommandLine;
-              count:=0;
-              while true do
-                begin
-                   { skip leading spaces }
-                   while cmdline^ in [' ',#9] do
-                     cmdline:=cmdline+1;
-                   if cmdline^='"' then
-                     begin
-                        quote:=['"'];
-                        cmdline:=cmdline+1;
-                     end
-                   else
-                     quote:=[' ',#9];
-                   if cmdline^=#0 then
-                     break;
-                   if count=l then
-                     begin
-                        while (cmdline^<>#0) and not(cmdline^ in quote) do
-                          begin
-                             s:=s+cmdline^;
-                             cmdline:=cmdline+1;
-                          end;
-                        break;
-                     end
-                   else
-                     begin
-                        while (cmdline^<>#0) and not(cmdline^ in quote) do
-                          cmdline:=cmdline+1;
-                     end;
-                   { skip quote }
-                   if cmdline^ in quote then
-                     cmdline:=cmdline+1;
-                   inc(count);
-                end;
-
-           end;
-         paramstr:=s;
-      end;
+procedure randomize;
+begin
+  randseed:=GetTickCount;
+end;
 
-    procedure randomize;
 
-      begin
-         randseed:=GetTickCount;
-      end;
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
 
-{$i winheap.inc}
-{ $I heap.inc}
+{ Include Windows Heap manager }
+{$I winheap.inc}
 
-{****************************************************************************
+{*****************************************************************************
                           Low Level File Routines
- ****************************************************************************}
-
-    procedure AllowSlash(p:pchar);
-
-      var
-         i : longint;
+*****************************************************************************}
 
-      begin
-         { allow slash as backslash }
-         for i:=0 to strlen(p) do
-           if p[i]='/' then p[i]:='\';
-      end;
+   function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
+     overlap:pointer):longint;
+     external 'kernel32' name 'WriteFile';
+   function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
+     overlap:pointer):longint;
+     external 'kernel32' name 'ReadFile';
+   function CloseHandle(h : longint) : longint;
+     external 'kernel32' name 'CloseHandle';
+   function DeleteFile(p : pchar) : longint;
+     external 'kernel32' name 'DeleteFileA';
+   function MoveFile(old,_new : pchar) : longint;
+     external 'kernel32' name 'MoveFileA';
+   function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
+     external 'kernel32' name 'SetFilePointer';
+   function GetFileSize(h:longint;p:pointer) : longint;
+     external 'kernel32' name 'GetFileSize';
+   function CreateFile(name : pointer;access,sharing : longint;
+     security : pointer;how,attr,template : longint) : longint;
+     external 'kernel32' name 'CreateFileA';
+   function SetEndOfFile(h : longint) : boolean;
+     external 'kernel32' name 'SetEndOfFile';
+
+
+procedure AllowSlash(p:pchar);
+var
+   i : longint;
+begin
+{ allow slash as backslash }
+   for i:=0 to strlen(p) do
+     if p[i]='/' then p[i]:='\';
+end;
 
-    procedure do_close(h : longint);
 
-      begin
-         closehandle(h);
-      end;
+procedure do_close(h : longint);
+begin
+   closehandle(h);
+end;
 
-    procedure do_erase(p : pchar);
 
-      begin
-         AllowSlash(p);
-         if DeleteFile(p)=0 then
-            inoutres:=GetLastError;
-      end;
+procedure do_erase(p : pchar);
+begin
+   AllowSlash(p);
+   if DeleteFile(p)=0 then
+      inoutres:=GetLastError;
+end;
 
-     procedure do_rename(p1,p2 : pchar);
 
-       begin
-          AllowSlash(p1);
-          AllowSlash(p2);
-          if MoveFile(p1,p2)=0 then
-            inoutres:=GetLastError;
-       end;
+procedure do_rename(p1,p2 : pchar);
+begin
+  AllowSlash(p1);
+  AllowSlash(p2);
+  if MoveFile(p1,p2)=0 then
+   inoutres:=GetLastError;
+end;
 
-    function do_write(h,addr,len : longint) : longint;
 
-      var
-         size:longint;
+function do_write(h,addr,len : longint) : longint;
+var
+   size:longint;
+begin
+   if writefile(h,pointer(addr),len,size,nil)=0 then
+     inoutres:=GetLastError;
+   do_write:=size;
+end;
 
-      begin
-         if writefile(h,pointer(addr),len,size,nil)=0 then
-           inoutres:=GetLastError;
-         do_write:=size;
-      end;
 
 function do_read(h,addr,len : longint) : longint;
- var
+var
   result:longint;
- begin
+begin
   if readfile(h,pointer(addr),len,result,nil)=0 then
    inoutres:=GetLastError;
   do_read:=result;
- end;
+end;
+
 
 function do_filepos(handle : longint) : longint;
- var
+var
   l:longint;
- begin
+begin
   l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
   if l=-1 then
    begin
@@ -260,7 +324,8 @@ function do_filepos(handle : longint) : longint;
     inoutres:=GetLastError;
    end;
   do_filepos:=l;
- end;
+end;
+
 
 procedure do_seek(handle,pos : longint);
 begin
@@ -268,8 +333,8 @@ begin
    inoutres:=GetLastError;
 end;
 
-function do_seekend(handle:longint):longint;
 
+function do_seekend(handle:longint):longint;
 begin
   do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
   if do_seekend=-1 then
@@ -282,14 +347,14 @@ end;
 
 function do_filesize(handle : longint) : longint;
 var
-   aktfilepos : longint;
+  aktfilepos : longint;
 begin
-   aktfilepos:=do_filepos(handle);
-   do_filesize:=do_seekend(handle);
-   do_seek(handle,aktfilepos);
+  aktfilepos:=do_filepos(handle);
+  do_filesize:=do_seekend(handle);
+  do_seek(handle,aktfilepos);
 end;
 
-{ truncate at a given position }
+
 procedure do_truncate (handle,pos:longint);
 begin
    do_seek(handle,pos);
@@ -297,94 +362,85 @@ begin
      inoutres:=GetLastError;
 end;
 
+
 procedure do_open(var f;p : pchar;flags:longint);
 
-  {
-    filerec and textrec have both handle and mode as the first items so
-    they could use the same routine for opening/creating.
-    when (flags and $10)   the file will be append
-    when (flags and $100)  the file will be truncate/rewritten
-    when (flags and $1000) there is no check for close (needed for textfiles)
-  }
-
-  var
-     oflags,cd : longint;
-
-  begin
-    AllowSlash(p);
-    { close first if opened }
-    if ((flags and $1000)=0) then
-     begin
-       case filerec(f).mode of
-          fminput,fmoutput,fminout:
-            Do_Close(filerec(f).handle);
-          fmclosed:
-            ;
-       else
-        begin
-          {not assigned}
-          inoutres:=102;
-          exit;
-        end;
-       end;
-     end;
-    { reset file handle }
-    filerec(f).handle:=UnusedHandle;
-    { convert filemode to filerec modes }
-    case (flags and 3) of
-       0:
-         begin
-            filerec(f).mode:=fminput;
-            oflags:=GENERIC_READ;
-         end;
-       1:
-         begin
-            filerec(f).mode:=fmoutput;
-            oflags:=GENERIC_WRITE;
-         end;
-       2:
-         begin
-            filerec(f).mode:=fminout;
-            oflags:=GENERIC_WRITE or GENERIC_READ;
-         end;
-    end;
-    { standard is opening and existing file }
-    cd:=OPEN_EXISTING;
-
-    { create it ? }
-    if (flags and $100)<>0 then
-       cd:=CREATE_ALWAYS
-
-    { or append ? }
-    else if (flags and $10)<>0 then
-       cd:=OPEN_ALWAYS;
-
-    { empty name is special }
-    if p[0]=#0 then
-     begin
-        case filerec(f).mode of
-           fminput:
-             filerec(f).handle:=StdInputHandle;
-           fmappend,
-           fmoutput:
-             begin
-                filerec(f).handle:=StdOutputHandle;
-                filerec(f).mode:=fmoutput; {fool fmappend}
-             end;
-        end;
-        exit;
-     end;
-    filerec(f).handle:=CreateFile(p,oflags,0,nil,cd,FILE_ATTRIBUTE_NORMAL,0);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $10)   the file will be append
+  when (flags and $100)  the file will be truncate/rewritten
+  when (flags and $1000) there is no check for close (needed for textfiles)
+}
 
-    { append mode }
-    if (flags and $10)<>0 then
-     begin
-       do_seekend(filerec(f).handle);
-       filerec(f).mode:=fmoutput; {fool fmappend}
+var
+  oflags,cd : longint;
+begin
+  AllowSlash(p);
+{ close first if opened }
+  if ((flags and $1000)=0) then
+   begin
+     case filerec(f).mode of
+       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+       fmclosed : ;
+     else
+      begin
+        {not assigned}
+        inoutres:=102;
+        exit;
+      end;
      end;
-     if filerec(f).handle=0 then
-       inoutres:=GetLastError;
+   end;
+{ reset file handle }
+  filerec(f).handle:=UnusedHandle;
+{ convert filemode to filerec modes }
+  case (flags and 3) of
+   0 : begin
+         filerec(f).mode:=fminput;
+         oflags:=GENERIC_READ;
+       end;
+   1 : begin
+         filerec(f).mode:=fmoutput;
+         oflags:=GENERIC_WRITE;
+       end;
+   2 : begin
+         filerec(f).mode:=fminout;
+         oflags:=GENERIC_WRITE or GENERIC_READ;
+       end;
   end;
+{ standard is opening and existing file }
+  cd:=OPEN_EXISTING;
+{ create it ? }
+  if (flags and $100)<>0 then
+   cd:=CREATE_ALWAYS
+{ or append ? }
+  else
+   if (flags and $10)<>0 then
+    cd:=OPEN_ALWAYS;
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case filerec(f).mode of
+       fminput : filerec(f).handle:=StdInputHandle;
+      fmappend,
+      fmoutput : begin
+                   filerec(f).handle:=StdOutputHandle;
+                   filerec(f).mode:=fmoutput; {fool fmappend}
+                 end;
+     end;
+     exit;
+   end;
+  filerec(f).handle:=CreateFile(p,oflags,0,nil,cd,FILE_ATTRIBUTE_NORMAL,0);
+{ append mode }
+  if (flags and $10)<>0 then
+   begin
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
+   end;
+{ get errors }
+  if filerec(f).handle=0 then
+   inoutres:=GetLastError;
+end;
 
 {*****************************************************************************
                            UnTyped File Handling
@@ -410,6 +466,15 @@ procedure do_open(var f;p : pchar;flags:longint);
                            Directory Handling
 *****************************************************************************}
 
+   function CreateDirectory(name : pointer;sec : pointer) : longint;
+     external 'kernel32' name 'CreateDirectoryA';
+   function RemoveDirectory(name:pointer):longint;
+     external 'kernel32' name 'RemoveDirectoryA';
+   function SetCurrentDirectory(name : pointer) : longint;
+     external 'kernel32' name 'SetCurrentDirectoryA';
+   function GetCurrentDirectory(bufsize : longint;name : pchar) : longint;
+     external 'kernel32' name 'GetCurrentDirectoryA';
+
 type
  TDirFnType=function(name:pointer):word;
 
@@ -468,6 +533,19 @@ procedure getdir(drivenr:byte;var dir:string);
                          SystemUnit Initialization
 *****************************************************************************}
 
+   { Startup }
+   procedure GetStartupInfo(p : pointer);
+     external 'kernel32' name 'GetStartupInfoA';
+   function GetStdHandle(nStdHandle:DWORD):THANDLE;
+     external 'kernel32' name 'GetStdHandle';
+
+   { module functions }
+   function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
+     external 'kernel32' name 'GetModuleFileNameA';
+   function GetModuleHandle(p : pointer) : longint;
+     external 'kernel32' name 'GetModuleHandleA';
+
+
 {$ASMMODE DIRECT}
 
 procedure Entry;[public,alias: '_mainCRTStartup'];
@@ -493,32 +571,9 @@ begin
   TextRec(f).Closefunc:=@fileclosefunc;
 end;
 
-{$PACKRECORDS 1}
-var
- s : string;
- StartupInfo : record
-    cb : longint;
-    lpReserved : Pointer;
-    lpDesktop : Pointer;
-    lpTitle : Pointer;
-    dwX : longint;
-    dwY : longint;
-    dwXSize : longint;
-    dwYSize : longint;
-    dwXCountChars : longint;
-    dwYCountChars : longint;
-    dwFillAttribute : longint;
-    dwFlags : longint;
-    wShowWindow : Word;
-    cbReserved2 : Word;
-    lpReserved2 : Pointer;
-    hStdInput : longint;
-    hStdOutput : longint;
-    hStdError : longint;
- end;
-
-{$PACKRECORDS NORMAL}
 
+var
+  s : string;
 begin
 { get some helpful informations }
   GetStartupInfo(@startupinfo);
@@ -546,7 +601,10 @@ end.
 
 {
   $Log$
-  Revision 1.8  1998-06-08 23:07:47  peter
+  Revision 1.9  1998-06-10 10:39:17  peter
+    * working w32 rtl
+
+  Revision 1.8  1998/06/08 23:07:47  peter
     * dos interface is now 100% compatible
     * fixed call PASCALMAIN which must be direct asm
 
@@ -564,10 +622,4 @@ end.
 
   Revision 1.3  1998/04/26 21:49:57  florian
     + more stuff added (??dir procedures etc.)
-
-  Revision 1.2  1998/03/27 00:50:22  peter
-    * small fixes so it compiles
-
-  Revision 1.1.1.1  1998/03/25 11:18:47  root
-  * Restored version
 }

rtl/win32/win32.inc

@@ -1,11 +1,9 @@
 {
     $Id$
-    This file contains the Win32-API import declarations
-    for the system unit and the DOS unit
-
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1997,98 by Florian Klaempfl,
-    member of the Free Pascal development team.
+    Copyright (c) 1998 by the Free Pascal development team.
+
+    Win32 Types and Constants
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -16,204 +14,97 @@
 
  **********************************************************************}
 
-    const
-       { constants for GetStdHandle }
-       STD_INPUT_HANDLE = $fffffff6;
-       STD_OUTPUT_HANDLE = $fffffff5;
-       STD_ERROR_HANDLE = $fffffff4;
-       INVALID_HANDLE_VALUE = $ffffffff;
-
-       { flags for CreateFile }
-       GENERIC_READ=$80000000;
-       GENERIC_WRITE=$40000000;
-       CREATE_NEW = 1;
-       CREATE_ALWAYS = 2;
-       OPEN_EXISTING = 3;
-       OPEN_ALWAYS = 4;
-       TRUNCATE_EXISTING = 5;
-
-       FILE_ATTRIBUTE_ARCHIVE = 32;
-       FILE_ATTRIBUTE_COMPRESSED = 2048;
-       FILE_ATTRIBUTE_NORMAL = 128;
-       FILE_ATTRIBUTE_DIRECTORY = 16;
-       FILE_ATTRIBUTE_HIDDEN = 2;
-       FILE_ATTRIBUTE_READONLY = 1;
-       FILE_ATTRIBUTE_SYSTEM = 4;
-       FILE_ATTRIBUTE_TEMPORARY = 256;
-
-       { flags for SetFilePos }
-       FILE_BEGIN = 0;
-       FILE_CURRENT = 1;
-       FILE_END = 2;
-
-    type
-       UINT = longint;
-       LPDWORD = ^DWORD;
-       BOOL = longint;
+const
+   { constants for GetStdHandle }
+   STD_INPUT_HANDLE = $fffffff6;
+   STD_OUTPUT_HANDLE = $fffffff5;
+   STD_ERROR_HANDLE = $fffffff4;
+   INVALID_HANDLE_VALUE = $ffffffff;
+
+   IGNORE = 0;               { Ignore signal }
+   INFINITE = $FFFFFFFF;     { Infinite timeout }
+
+   { flags for CreateFile }
+   GENERIC_READ=$80000000;
+   GENERIC_WRITE=$40000000;
+   CREATE_NEW = 1;
+   CREATE_ALWAYS = 2;
+   OPEN_EXISTING = 3;
+   OPEN_ALWAYS = 4;
+   TRUNCATE_EXISTING = 5;
+
+   FILE_ATTRIBUTE_ARCHIVE = 32;
+   FILE_ATTRIBUTE_COMPRESSED = 2048;
+   FILE_ATTRIBUTE_NORMAL = 128;
+   FILE_ATTRIBUTE_DIRECTORY = 16;
+   FILE_ATTRIBUTE_HIDDEN = 2;
+   FILE_ATTRIBUTE_READONLY = 1;
+   FILE_ATTRIBUTE_SYSTEM = 4;
+   FILE_ATTRIBUTE_TEMPORARY = 256;
+
+   { flags for SetFilePos }
+   FILE_BEGIN = 0;
+   FILE_CURRENT = 1;
+   FILE_END = 2;
+
+type
+   UINT  = longint;
+   BOOL  = longint;
+   WCHAR = word;
 {$ifdef UNICODE}
-       LPTCH = ^word;
-       LPTSTR = ^word;
-       LPCTSTR = ^word;
+   LPTCH   = ^word;
+   LPTSTR  = ^word;
+   LPCTSTR = ^word;
 {$else UNICODE}
-       LPTCH = ^char;
-       LPTSTR = ^char;
-       LPCTSTR = ^char;
+   LPTCH   = ^char;
+   LPTSTR  = ^char;
+   LPCTSTR = ^char;
 {$endif UNICODE}
-       PVOID = pointer;
-       LPVOID = pointer;
-       LPCVOID = pointer;
-       HANDLE = pointer;
-       HLOCAL = HANDLE;
-       PSTR = pchar;
-
-       OVERLAPPED = record
-         Internal : DWORD;
-         InternalHigh : DWORD;
-         Offset : DWORD;
-         OffsetHigh : DWORD;
-         hEvent : HANDLE;
-       end;
-
-       LPOVERLAPPED = ^OVERLAPPED;
-
-       SYSTEMTIME = record
-         wYear,wMonth,wDayOfWeek,wDay,
-	 wHour,wMinute,wSecond,WMilliseconds : word;
-       end;
-
-       FILETIME = record
-         dwLowDateTime : longint;
-         dwHighDateTime : longint;
-       end;
-
-       PFILETIME = ^FILETIME;
-
-   { command line/enviroment functions }
-   function GetCommandLine : LPTSTR;
-     external 'kernel32' name 'GetCommandLineA';
-   function GetEnvironmentStrings : pchar;
-     external 'kernel32' name 'GetEnvironmentStringsA';
-   function FreeEnvironmentStrings(p : pchar) : boolean;
-     external 'kernel32' name 'FreeEnvironmentStringsA';
-
-   { string functions
-   function lstrlen(lpString:LPCTSTR):longint;external;
-   function lstrcat(lpString1:LPTSTR; lpString2:LPCTSTR):LPTSTR;external;
-   function lstrcpy(lpString1:LPTSTR; lpString2:LPCTSTR):LPTSTR;external;
-   }
-
-   { process functions }
-   procedure ExitProcess(uExitCode : UINT);
-     external 'kernel32' name 'ExitProcess';
-
-   { file functions }
-   function GetStdHandle(nStdHandle:DWORD):HANDLE;
-     external 'kernel32' name 'GetStdHandle';
-   function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
-     overlap:pointer):longint;
-     external 'kernel32' name 'WriteFile';
-   function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
-     overlap:pointer):longint;
-     external 'kernel32' name 'ReadFile';
-   function CloseHandle(h : longint) : longint;
-     external 'kernel32' name 'CloseHandle';
-   function DeleteFile(p : pchar) : longint;
-     external 'kernel32' name 'DeleteFileA';
-   function MoveFile(old,_new : pchar) : longint;
-     external 'kernel32' name 'MoveFileA';
-   function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
-     external 'kernel32' name 'SetFilePointer';
-   function GetFileSize(h:longint;p:pointer) : longint;
-     external 'kernel32' name 'GetFileSize';
-   function CreateFile(name : pointer;access,sharing : longint;
-     security : pointer;how,attr,template : longint) : longint;
-     external 'kernel32' name 'CreateFileA';
-   function CreateDirectory(name : pointer;sec : pointer) : longint;
-     external 'kernel32' name 'CreateDirectoryA';
-   function RemoveDirectory(name:pointer):longint;
-     external 'kernel32' name 'RemoveDirectoryA';
-   function SetCurrentDirectory(name : pointer) : longint;
-     external 'kernel32' name 'SetCurrentDirectoryA';
-   function GetCurrentDirectory(bufsize : longint;name : pchar) : longint;
-     external 'kernel32' name 'GetCurrentDirectoryA';
-   function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : boolean;
-     external 'kernel32' name 'SetFileAttributesA';
-   function GetFileAttributes(lpFileName : pchar) : longint;
-     external 'kernel32' name 'GetFileAttributesA';
-   function GetFileTime(h : longint;creation,lastaccess,lastwrite : PFILETIME) : boolean;
-     external 'kernel32' name 'GetFileTime';
-   function SetFileTime(h : longint;creation,lastaccess,lastwrite : PFILETIME) : boolean;
-     external 'kernel32' name 'SetFileTime';
-   function SetEndOfFile(h : longint) : boolean;
-     external 'kernel32' name 'SetEndOfFile';
-
-   { module functions }
-   function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
-     external 'kernel32' name 'GetModuleFileNameA';
-   procedure GetStartupInfo(p : pointer);
-     external 'kernel32' name 'GetStartupInfoA';
-   function GetModuleHandle(p : pointer) : longint;
-     external 'kernel32' name 'GetModuleHandleA';
-
-   { memory functions }
-   function GlobalAlloc(mode,size:longint):longint;
-     external 'kernel32' name 'GlobalAlloc';
-   function GlobalHandle(p:pointer):longint;
-     external 'kernel32' name 'GlobalHandle';
-   function GlobalLock(handle:longint):pointer;
-     external 'kernel32' name 'GlobalLock';
-   function GlobalUnlock(h:longint):longint;
-     external 'kernel32' name 'GlobalUnlock';
-   function GlobalFree(h:longint):longint;
-     external 'kernel32' name 'GlobalUnlock';
-   procedure GlobalMemoryStatus(p:pointer);
-     external 'kernel32' name 'GlobalMemoryStatus';
-   function LocalAlloc(uFlags : UINT;uBytes :UINT) : HLOCAL;
-     external 'kernel32' name 'LocalAlloc';
-   function LocalFree(hMem:HLOCAL):HLOCAL;
-     external 'kernel32' name 'LocalFree';
-
-   { time and date functions }
-   procedure GetLocalTime(var t : SYSTEMTIME);
-     external 'kernel32' name 'GetLocalTime';
-   function SetLocalTime(const t : SYSTEMTIME) : boolean;
-     external 'kernel32' name 'SetLocalTime';
-   function FileTimeToDosDateTime(const ft : FILETIME;var data,time : word) : boolean;
-     external 'kernel32' name 'FileTimeToDosDateTime';
-   function DosDateTimeToFileTime(date,time : word;var ft : FILETIME) : boolean;
-     external 'kernel32' name 'DosDateTimeToFileTime';
-   function GetTickCount : longint;
-     external 'kernel32' name 'GetTickCount';
-   function FileTimeToLocalFileTime(const ft : FILETIME;var lft : FILETIME) : boolean;
-     external 'kernel32' name 'FileTimeToLocalFileTime';
-   function LocalFileTimeToFileTime(const lft : FILETIME;var ft : FILETIME) : boolean;
-     external 'kernel32' name 'LocalFileTimeToFileTime';
-
-   { misc. functions }
-   function GetLastError : DWORD;
-     external 'kernel32' name 'GetLastError';
-   function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
-     external 'user32' name 'MessageBoxA';
-   function GetVersion : longint;
-     external 'kernel32' name 'GetVersion';
+   PVOID   = pointer;
+   LPVOID  = pointer;
+   LPCVOID = pointer;
+   LPDWORD = ^DWORD;
+   THandle = longint;
+   HLocal  = THandle;
+   PStr    = pchar;
+   LPStr   = pchar;
+
+  PSecurityAttributes = ^TSecurityAttributes;
+  TSecurityAttributes = record
+    nLength : DWORD;
+    lpSecurityDescriptor : Pointer;
+    bInheritHandle : Boolean;
+  end;
+
+  PProcessInformation = ^TProcessInformation;
+  TProcessInformation = record
+    hProcess: THandle;
+    hThread: THandle;
+    dwProcessId: DWORD;
+    dwThreadId: DWORD;
+  end;
+
+  PFileTime = ^TFileTime;
+  TFileTime = record
+    dwLowDateTime,
+    dwHighDateTime : DWORD;
+  end;
+
+  PSystemTime = ^TSystemTime;
+  TSystemTime = record
+    wYear,
+    wMonth,
+    wDayOfWeek,
+    wDay,
+    wHour,
+    wMinute,
+    wSecond,
+    wMilliseconds: Word;
+  end;
 
 {
   $Log$
-  Revision 1.6  1998-05-06 12:37:22  michael
-  + Removed log from before restored version.
-
-  Revision 1.5  1998/04/27 18:25:36  florian
-    + constants for CreateFile added
-
-  Revision 1.4  1998/04/26 22:37:22  florian
-    * some small extensions
-
-  Revision 1.3  1998/04/26 21:49:58  florian
-    + more stuff added (??dir procedures etc.)
-
-  Revision 1.2  1998/03/27 00:50:22  peter
-    * small fixes so it compiles
+  Revision 1.7  1998-06-10 10:39:18  peter
+    * working w32 rtl
 
-  Revision 1.1.1.1  1998/03/25 11:18:47  root
-  * Restored version
 }

rtl/win32/winheap.inc

@@ -1,9 +1,9 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    FPC Pascal system unit for the Win32 API.
-    Copyright (c) 1998 by Florian Klaempfl and Pavel Ozerski
-    member of the Free Pascal development team.
+    Copyright (c) 1998 by the Free Pascal development team.
+
+    Win32 Memory Functions
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,40 +14,58 @@
 
  **********************************************************************}
 
+   { memory functions }
+   function GlobalAlloc(mode,size:longint):longint;
+     external 'kernel32' name 'GlobalAlloc';
+   function GlobalHandle(p:pointer):longint;
+     external 'kernel32' name 'GlobalHandle';
+   function GlobalLock(handle:longint):pointer;
+     external 'kernel32' name 'GlobalLock';
+   function GlobalUnlock(h:longint):longint;
+     external 'kernel32' name 'GlobalUnlock';
+   function GlobalFree(h:longint):longint;
+     external 'kernel32' name 'GlobalUnlock';
+   procedure GlobalMemoryStatus(p:pointer);
+     external 'kernel32' name 'GlobalMemoryStatus';
+   function LocalAlloc(uFlags : UINT;uBytes :UINT) : HLOCAL;
+     external 'kernel32' name 'LocalAlloc';
+   function LocalFree(hMem:HLOCAL):HLOCAL;
+     external 'kernel32' name 'LocalFree';
+
+
 type
- errproc=function(size:longint):integer;
+  errproc=function(size:longint):integer;
 
 procedure MemError(size:longint);
- const
-  message:array[1..21]of char=(
-   'A','b','n','o','r','m','a','l',' ',
-   'T','e','r','m','i','n','a','t','i','o','n',#0);
-  caption:array[1..25]of char=(
-   'M','e','m','o','r','y',' ',
-   'M','a','n','a','g','e','m','e','n','t',' ',
-   'E','r','r','o','r','!',#0);
- var
+const
+  message:pchar='Abnormal Termination';
+  caption:pchar='Memory Management Error!';
+var
   res:integer;
- begin
+begin
   repeat
-   res:=errproc(heaperror)(size);
-   if res=0 then
-    begin;
-     messagebox(0,@caption,@message,$10);
-     halt(getlasterror);
-    end;
+    res:=errproc(heaperror)(size);
+    if res=0 then
+     begin;
+       messagebox(0,caption,message,$10);
+       halt(getlasterror);
+     end;
   until res<>2;
- end;
+end;
+
+
 procedure getmem(var p:pointer;size:longint);[public,alias: 'GETMEM'];
- begin
+begin
   p:=GlobalLock(GlobalAlloc(258,size));
   if p=nil then
    memerror(size)
- end;
+end;
+
+
 procedure freemem(var p:pointer;size:longint);[public,alias: 'FREEMEM'];
- var
+var
   h:longint;
- begin
+begin
   h:=GlobalHandle(p);
   if h<>0 then
    if globalunlock(h)=0 then
@@ -58,10 +76,11 @@ procedure freemem(var p:pointer;size:longint);[public,alias: 'FREEMEM'];
      end;
   p:=nil;
   memerror(size);
- end;
+end;
+
 
 function memmax(_maxavail:boolean):longint;
- const
+const
   status:record
    dwLength,
    dwMemoryLoad,
@@ -72,31 +91,36 @@ function memmax(_maxavail:boolean):longint;
    dwTotalVirtual,
    dwAvailVirtual:longint;
   end=(dwLength:32);
- begin
+begin
   GlobalMemoryStatus(@status);
   if _maxavail then
    memmax:=status.dwAvailPageFile
   else
    memmax:=status.dwAvailVirtual;
- end;
+end;
+
+
 function memavail:longint;
- begin
+begin
   memavail:=memmax(false);
- end;
+end;
+
+
 function maxavail:longint;
- begin
+begin
   maxavail:=memmax(true);
- end;
+end;
+
+
 function growheap(size:longint):integer;
- begin
+begin
   growheap:=0;
- end;
+end;
 
 {
   $Log$
-  Revision 1.2  1998-05-06 12:37:22  michael
-  + Removed log from before restored version.
+  Revision 1.3  1998-06-10 10:39:19  peter
+    * working w32 rtl
 
-  Revision 1.1.1.1  1998/03/25 11:18:47  root
-  * Restored version
 }
+