 Home |
15 A. Program Code for UseFiles UseFiles a Program for Writting and Reading files |
Home |
This page contains the code used to make the UseFiles program, which is about the file access methods that are in Lesson 15. For this program there is the UseFiles.dpr program file and three units called - UseFilesU.pas , SplitFilesU.pas and DataFilesU.pas . . This program also uses the MakeApp.pas unit fron lesson 13. The "Main" unit for this is the UseFilesU.pas , this has the startup code that creates the windows and processes their messages. It has the code to creates a system "Tab Control" with 3 tabs on it, which are used to change "Pages" shown to the user. Page one is a text editor page, page two is the "Split File" page, page three is the "Muti-Segment" data file page. The UseFilesU unit only has the code used to read and write a "Text" file used in the text editor, multi-line Edit control. The code use for tab page two "File Splitting", is in the SplitFileU.pas unit. In this unit you are shown how to transfer bytes from one file to another. The code used for tab page three "Data Files", in in the DataFilesU.pas unit. The code in this unit shows you how to place your data bytes in a file as a "Data Segment", so you can have several program variables stored in one file and then read them to for information that your program requires. |
UseFiles Program Code The code methods for file access in this program are explained in Lesson 15 - Writing and Reading Files -. You shoud have read Lesson 15 and some of the Win32 Help subjects recomended there for information about the CreateFile( ) function and using file handles. Below is alot of code for this program, By this point in these lessons, I hope that you have enough experience with API methods to go through the code units below and work with just one or two functions at a time. I did not present this as many small - step by step - code units. But I have sorted the code into 3 units and the program file. Since there is so much code here, I have a link to a ZIP file that has all of the program code and Units used here -
UseFiles.DPR Program File You have seen the methods for this program file in Lesson-11 and Lesson-13 - MakeApp Unit - You will need the MakeApp.pas unit from Lesson-13 for this program file and the UseFilesU.pas unit. I have included the ThemeXP.RES resource to have the themes GUI on this program, this code for this ThemeXP.RES is in Lesson-12 - Visual Themes in XP - . You can leave out the ThemeXP.RES resource with no effect on the code below. |
program UseFiles;
uses
MakeApp, UseFilesU;
{$R *.RES}
{$R ThemeXP.RES}
// ThemeXP.RES has the Theme manifest in it
begin
if MakeProgram then // MakeProgram in UseFilesU
RunMsgLoop; // RunMsgLoop in MakeApp
end. |
UseFilesU Unit This is the "Main Unit" for this program and has the code for all window creation and message handling, along with code for the first tab control page for text file writting and reading. This uses window creation methods that have already been explained here at DelphiZeus in lessons before. This unit uses the MakeApp.pas unit from Lesson-13 - MakeApp Unit for the main window (Form) creation and other windows (buttons, panel) and font creation. The new kind of system control in this code is a system "Tab Control" which is explained in Lesson-15. The code for creating a tab control is in the MakeControls procedure, this procedure also creates the fonts and 5 buttons. After the tab control is created, I need to create three "Page Windows" as pages for the tab control. Each page window is shown or hidden as the tab control changes selected tab. The first page is just a system multi-line EDIT control, which is used for a text editor to load and save text files. I wanted to show you that for Tab Control pages, that you can use many different kinds of "Container Windows" as a parent for controls that will be displayed for each separate "Page" of the tab control. The second page is a system STATIC control, which will be used as a "Container" window, NOT as a STATIC control. Code to create this Page 2 window and it's child controls is in the MakePage2 procedure. Page 3 is a "Panel" window from the MakeApp Unit, used as a "Container" window, code for creating Page 3 and it's child controls is in the MakePage3 procedure. The message handling function for hForm1 is MessageFunc, the new code methods in it are for the page changes for the tab control. In the WM_NOTIFY message processing, I test the WParam for the tab ID of ID_TabCtrl and then cast the LParam as a PNMHdr, to get the code member as a TCN_SELCHANGE or TCN_SELCHANGING value. This message does NOT have information about which tab it is for, so you have to ask the tab control which tab is selected with the TCM_GETCURSEL message. Then you hide and show the page windows for that tab selection. The two procedures that write and read a text file are SaveTextFile and LoadTextFile. |
unit UseFilesU;
interface
function MakeProgram: Boolean;
{the MakeProgram function will call some functions to create the windows and
controls for this Application. If there is a creation error, it returns False}
procedure SysErrorMsg(const Text, Title: String);
// shows message box with system error text
function GetSplitFolder: String;
// will get the folder path from the hFolderEdit edit
function OpenDialog1(Use1: Cardinal): String;
// shows the Open and Save dialogs
const
One = 1;
Two = 2;
// below are Radio Button ID
ID_1MegRB = 1010;
ID_EqualRB = 1011;
// message box file access error text is below
Err = 'ERROR - ';
CreateErrText = 'System could NOT Create file';
CreateErrTitle = 'Did NOT Create File';
ReadErrText = 'System could NOT Read file';
ReadErrTitle = 'Did NOT Read File';
WriteErrText = 'System could NOT Write file';
WriteErrTitle = 'Did Not Write File';
var
hForm1: Integer = 0; // handle of Main Window (Form)
hPage2, hIntEdit, hStrEdit, hListBox, hEdit2: Integer;
implementation
uses
Windows, Messages, SplitFilesU, DataFilesU, ShlObj, ActiveX,
MakeApp, CommDlg, CommCtrl, SmallUtils;
// ActiveX is needed for the shell IMAlloc
const
butHeight = 24;
// control ID numbers below
ID_ExitBut = 1000;
ID_LoadTBut = 1001;
ID_SaveTBut = 1002;
ID_TabGetBut = 1003;
ID_TabSetBut = 1004;
ID_SplitBut = 1005;
ID_RestoreBut = 1006;
ID_CopyFileBut = 1007;
ID_OpenSplitBut = 1008;
ID_OpenResBut = 1009;
ID_DataNameBut = 1012;
ID_SaveFixedBut = 1013;
ID_LoadFixedBut = 1014;
ID_SaveData1But = 1015;
ID_LoadData1But = 1016;
ID_SaveVar1But = 1017;
ID_LoadVar1But = 1018;
ID_SaveStrBut = 1019;
ID_GetListBut = 1020;
ID_LoadStrBut =1021;
ID_TabCtrl = 2000;
TextRect: TRect = (left: 290; Top: 142; Right: 510; Bottom: 164);
// TextRect has the area needed for hPage2 refresh of the File Size text
var
Font1, Font2, Font3, hTab1, hPage1, hPage3, hFolderEdit, hSplitEdit,
hRestEdit, hDataEdit, hVarEdit, hButTab: Integer;
pPageProc: Pointer;
sFileSize, PersonalFolder: String;
// PersonalFolder will have the path for the user's My Documents folder
FirstOpen: Boolean = True;
procedure SysErrorMsg(const Text, Title: String);
begin
// shows a message box that adds the system error text
MessageBox(hForm1, PChar(Err+Text+#10+ SysErrorMessage(GetLastError)),
PChar(Err+Title), MB_ICONERROR);
end;
function GetSplitFolder: String;
begin
// gets the text out of hFolderEdit and test for the folder
Result := GetWindowStr(hFolderEdit);
if not DirectoryExists(Result) then
begin
MessageBox(hForm1, 'ERROR - You must Have a valid Folder Path in the'+
' Folder Edit box', 'ERROR - Not a Valid Folder', MB_ICONERROR);
Result := '';
Exit;
end;
end;
// OpenDialog1 shows the system Open and Save Dialog boxes
function OpenDialog1(Use1: Cardinal): String;
var
OfName : TOpenFilename;
FileName: Array[Zero..2047] of Char;
begin
ZeroMemory(@FileName, SizeOf(FileName));
ZeroMemory(@Ofname, SizeOf(OfName));
with OfName do
begin
lStructSize := sizeof(OfName);
hWndOwner := hForm1;
hInstance := SysInit.hInstance;
nMaxFile := SizeOf(FileName);
lpStrFile := @FileName;
Flags := OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_HIDEREADONLY;
Case Use1 of // Use1 is set to change filter and title
Zero: begin
lpstrFilter := 'Text files .TXT'#0'*.txt'#0'All files'#0'*.*'#0#0;
lpstrTitle := 'Open a Text File';
end;
One: begin
lpstrFilter := 'All files'#0'*.*'#0#0;
lpstrTitle := 'Open a File to Split';
end;
Two: begin
lpstrFilter := 'Split files 3p1, 1meg1'#0'*.3p1;*.1meg1'#0'All files'#0'*.*'#0#0;
lpstrTitle := 'Open a File to Restore';
end;
3: begin
lpstrFilter := 'Text files .TXT'#0'*.txt'#0'All files'#0'*.*'#0#0;
lpstrTitle := 'Save a Text File';
Flags := OFN_EXPLORER or OFN_PATHMUSTEXIST or
OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY;
end;
4: begin
lpstrFilter := 'Multi-Data files .MDTF'#0'*.mdtf'#0'All files'#0'*.*'#0#0;
lpstrTitle := 'Save a Multi-Data File';
lpstrDefExt := 'mdtf';
Flags := OFN_EXPLORER or OFN_PATHMUSTEXIST or OFN_OVERWRITEPROMPT or
OFN_HIDEREADONLY or OFN_EXTENSIONDIFFERENT;
end;
5: begin
lpstrFilter := 'All files'#0'*.*'#0#0;
lpstrTitle := 'Open a File to COPY';
end;
6: begin
lpstrFilter := 'All files'#0'*.*'#0#0;
lpstrTitle := 'Get File Name for New Copyed File';
Flags := OFN_EXPLORER or OFN_PATHMUSTEXIST or
OFN_OVERWRITEPROMPT or OFN_HIDEREADONLY;
end;
end;
nFilterIndex := One;
if FirstOpen then
begin
FirstOpen := False;
lpstrInitialDir:= PChar(PersonalFolder)
end;
end;
Result := '';
// if Use1 is 3, 4, or 6 then save dialog
if Use1 in [3,4,6] then
begin
if GetSaveFileName(ofName) then
Result := FileName;
end else // open dialog
if GetOpenFileName(ofName) then
Result := FileName;
end;
procedure SaveTextFile;
var
hFile, TextLength, BytesWrite: Cardinal;
FileName: String;
pText: PChar;
begin
// this procedure will open a file and write a PChar string into it
FileName := OpenDialog1( 3);
if Filename = '' then Exit;
hFile := CreateFile(PChar(FileName),GENERIC_WRITE,Zero,
nil, CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN,Zero);
{this file is opened with a Write Only flag, I have the share set to zero so
no other program and read or write to this file during the write operation.
By using the CREATE_ALWAYS flag a file is created or existing file is erased.
I use the FILE_FLAG_SEQUENTIAL_SCAN flag to allow the system to use a more
efficient file read and catching operations, however on small files this
makes no difference}
if hFile = INVALID_HANDLE_VALUE then
begin // check for open file
SysErrorMsg(CreateErrText+#10+FileName, CreateErrTitle);
Exit;
end;
// I will get the amount of text charaters in the multi-line edit
TextLength := GetWindowTextLength(hPage1);
if TextLength < One then
begin
// if the edit is empty then Close Handle and exit
CloseHandle(hFile);
Exit;
end;
GetMem(pText, TextLength+One); // add one for NULL charater
{this time I use a PChar, and get a memory block for it with GetMem( )}
GetWindowText(hPage1, pText, TextLength+One);
// you will need to dereference a Pointer, pText, for a WriteFile( )
if (not WriteFile(hFile, pText^, TextLength, BytesWrite, nil)) or
(TextLength <> BytesWrite) then
begin // test the FileWrite and also the BytesWrite to see if successful
CloseHandle(hFile);
DeleteFile(PChar(FileName)); // delete the file if there is a write error
SysErrorMsg(WriteErrText, WriteErrTitle);
end;
FreeMem(pText);
CloseHandle(hFile);
end;
procedure LoadTextFile;
const
pError: PChar = 'File Load ERROR';
var
hFile, SizeF, BytesRead: Cardinal;
Text1: String;
begin
// this procedure will open and read a text file into a string
Text1 := OpenDialog1(Zero);
if Text1 = '' then Exit;
hFile := CreateFile(PChar(Text1), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, Zero);
{ file is opened for reading only with GENERIC_READ, ,
For Share, I include a FILE_SHARE_READ to allow other programs to
read from this file.
The file must exist or a file error and no open file with OPEN_EXISTING.
The file Flag is set to FILE_FLAG_SEQUENTIAL_SCAN, which may help in
access speed for larger files}
if hFile = INVALID_HANDLE_VALUE then
begin
// file handle should be checked to see if system has located and opened the file
SysErrorMsg(CreateErrText+#10+Text1, CreateErrTitle);
Exit;
end;
SizeF := GetFileSize(hFile, nil);
// for most file reads you will need the size of the file on disk
if (SizeF = MAXDWORD) then
begin
{ the GetFileSize will usually work, although if the file is larger than
4 gigs and there is no lpFileSizeHigh it will fail}
CloseHandle(hFile);
// You must try to always use CloseHandle( ) when you are done with the file
MessageBox(hForm1, 'GetFileSize FAILED', pError, MB_ICONERROR);
Exit;
end;
if SizeF = Zero then
begin
// if the file size is zero, there is nothing in the file to read
CloseHandle(hFile);
SetWindowText(hPage1, nil);
Exit;
end;
if SizeF > 32768 then
begin
{ although text files have no file header information, you will ususally need to
test some property of the file bytes, to see if it is a file you want to use.
For an example, I just test for the size of 32 Kb, even though it is not nessary}
CloseHandle(hFile);
MessageBox(hForm1, PChar('ERROR, File size is MORE than 32,768'#10+
'CAN NOT LOAD, file is to large at '+Int2Thos(SizeF)),
pError, MB_ICONERROR);
Exit;
end;
// next are the file read operations
SetLength(Text1, SizeF);
{ a memory block is needed to read the file bytes into, since this is for text
charaters I use a String, and to get the memory I use SetLength( ) }
{the next code is typical for a file read, ReadFile( ) will return False
if it fails. You should also test the BytesRead for the amount that the
file should read thats in SizeF}
if not ReadFile(hFile, Text1[One], SizeF, BytesRead, nil) or (SizeF <> BytesRead) then
begin
SysErrorMsg(ReadErrText, ReadErrTitle);
CloseHandle(hFile);
Exit;
end;
CloseHandle(hFile);
// always be sure to CloseHandle( )
SetWindowText(hPage1, @Text1[One]);
//Place the Text1 string in to the Muti-line Edit hPage1
end;
function PageFunc(hWnd, Msg, WParam, LParam: Integer): Integer; stdcall;
begin
// inorder to get Tab keys, I subclass the muti-line Edit (hPage1)
case Msg of
WM_GETDLGCODE:
begin
{WM_GETDLGCODE is sent to SubClassed Proc to get a result
that will tell the OS which Keys to use or not for the Dialog
keys, a multiline edit will be less easy to get Tab Stop
functioning, because it may need Tab key input}
Result := DLGC_WANTALLKEYS;
{DLGC_WANTALLKEYS tells the OS to send all keys to this Edit Box
Multi-Line Edits should get all keys}
Exit;
end;
end;
Result := CallWindowProc(pPageProc,hWnd,Msg,wParam,lParam);
end;
procedure GetTheFile(Opp: Cardinal);
var
FileName: String;
ErrorMode, hFind: Cardinal;
FindData: TWin32FindData;
begin
// this procedure gets the file size of the file to split, to display on hPage2
if (Opp < One) or (Opp > Two) then Exit;
FileName := OpenDialog1( Opp);
if Filename = '' then Exit;
if Opp = One then
begin
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
hFind := FindFirstFile(PChar(FileName), FindData);
SetErrorMode(ErrorMode);
if hFind <> INVALID_HANDLE_VALUE then
begin
FindClose(hFind);
sFileSize := 'File Size '+Int2Thos(FindData.nFileSizeLow)+' bytes';
SetWindowText(hSplitEdit, PChar(FileName));
end else
sFileSize := 'Invalid File';
InvalidateRect(hPage2, @TextRect, True);
end else
SetWindowText(hRestEdit, PChar(FileName));
end;
function Page2MsgFunc(hWnd,Msg,wParam,lParam:Integer):Integer; stdcall;
var
PaintS: TPaintStruct;
cRect: TRect;
begin
// this is the messages processing for the STATIC window hPage2
case Msg of
WM_PAINT:
begin
{On Page 2 I draw text and I draw two 3D bars}
BeginPaint(hWnd, PaintS);
SetBkMode(PaintS.hdc, TRANSPARENT);
TextOut(PaintS.hdc,TextRect.Left,TextRect.Top, PChar(sFileSize),Length(sFileSize));
SelectObject(PaintS.hdc, VarFont);
TextOut(PaintS.hdc,84,198, 'Folder where split files go -',29);
SetBkColor(PaintS.hdc, $99FF99);
SelectObject(PaintS.hdc, Font1);
SetBkMode(PaintS.hdc, OPAQUE);
// the text draw below are for the titles on the page with a green background
TextOut(PaintS.hdc,236,6, ' Copy a File ',13);
TextOut(PaintS.hdc,240,86, ' Split a File ',14);
TextOut(PaintS.hdc,226,270, ' Restore a File ',16);
{the line drwing code below will draw two green 3D bars on the page}
SelectObject(PaintS.hdc, CreatePen(PS_SOLID,Zero, $FCFFF4));
// this first line draw is for the HighLight color
MoveToEx(PaintS.hdc,Zero,256,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,256);
MoveToEx(PaintS.hdc,Zero,74,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,74);
DeleteObject(SelectObject(PaintS.hdc, CreatePen(PS_DOT,Zero, $70A260)));
// a green Dot pen is used to draw the line body, with 3 lines
MoveToEx(PaintS.hdc,Zero,255,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,255);
MoveToEx(PaintS.hdc,Zero,73,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,73);
MoveToEx(PaintS.hdc,Zero,257,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,257);
MoveToEx(PaintS.hdc,Zero,75,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,75);
MoveToEx(PaintS.hdc,Zero,258,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,258);
MoveToEx(PaintS.hdc,Zero,76,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,76);
DeleteObject(SelectObject(PaintS.hdc, GetStockObject(BLACK_PEN)));
// a black pen is used to draw the shadow line
MoveToEx(PaintS.hdc,Zero,259,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,259);
MoveToEx(PaintS.hdc,Zero,77,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,77);
EndPaint(hWnd,PaintS);
Result := Zero;
Exit; // Does NOT allow DefWindowProc to be called
end;
WM_ERASEBKGND:
begin
GetClientRect(hWnd, cRect);
SelectObject(wParam, GetSysColorBrush(COLOR_BTNFACE));
PatBlt(wParam,Zero,Zero,cRect.Right,cRect.Bottom, PATCOPY);
Result := One;
Exit;
end;
// below are the button click messages for page 2
WM_COMMAND: case LOWORD(wParam) of
ID_CopyFileBut: CopyAFile; // the split procedures are in SplitFilesU.pas
ID_SplitBut: StartSplit(GetWindowStr(hSplitEdit));
ID_RestoreBut: StartRestore(GetWindowStr(hRestEdit));
ID_OpenSplitBut: GetTheFile(One);
ID_OpenResBut: GetTheFile(Two);
end;
end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
{ PLEASE NOTICE. . . I do NOT use the system STATIC message processing
I use the DefWindowProc( ) because I do NOT want STATIC window functioning}
end;
function PanelFunc1(iMsg,wParam,lParam:Integer):Integer;
var
PaintS: TPaintStruct;
FileName: String;
begin
// this is the message function for Page 3, a panel
Result := -2; // -2 will call the Default system message processing
case iMsg of
WM_PAINT:
begin
BeginPaint(hPage3, PaintS); // use the hPage3 handle
SetBkColor(PaintS.hdc, $FFBAC2);
SelectObject(PaintS.hdc, Font1);
// text draw below is for the Titles on page 2
TextOut(PaintS.hdc,170,4, ' Save Fixed Data to a File ',27);
TextOut(PaintS.hdc,156,188, ' Save Variable Data to a File ',30);
// the line draws below create a 3D bar on the page
SelectObject(PaintS.hdc, CreatePen(PS_SOLID,Zero, $FFE4DC));
MoveToEx(PaintS.hdc,Zero,172,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,172);
DeleteObject(SelectObject(PaintS.hdc, CreatePen(PS_DOT,Zero, $666666)));
MoveToEx(PaintS.hdc,Zero,171,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,171);
MoveToEx(PaintS.hdc,Zero,173,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,173);
MoveToEx(PaintS.hdc,Zero,174,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,174);
// draws smaller line
MoveToEx(PaintS.hdc,110,269,nil);
LineTo(PaintS.hdc,494,269);
MoveToEx(PaintS.hdc,110,270,nil);
LineTo(PaintS.hdc,494,270);
DeleteObject(SelectObject(PaintS.hdc, GetStockObject(BLACK_PEN)));
MoveToEx(PaintS.hdc,Zero,175,nil);
LineTo(PaintS.hdc,PaintS.rcPaint.Right,175);
MoveToEx(PaintS.hdc,110,271,nil);
LineTo(PaintS.hdc,494,271);
SelectObject(PaintS.hdc, VarFont);
SetBkMode(PaintS.hdc, TRANSPARENT);
TextOut(PaintS.hdc,2,32, 'path --> C:\Data File 1.FixedData',33);
EndPaint(hPage3,PaintS);
Result := Zero; // Does NOT allow DefWindowProc to be called
end;
WM_COMMAND: if LOWORD(wParam) = ID_DataNameBut then
begin
FileName := OpenDialog1( 4);
if Filename = '' then Exit;
SetWindowText(hDataEdit, PChar(FileName));
end else // data file procedures below are in DataFilesU.pas
case LOWORD(wParam) of
ID_SaveFixedBut: SaveFixed;
ID_LoadFixedBut: LoadFixed;
ID_SaveData1But: SaveRecords(GetWindowStr(hDataEdit));
ID_LoadData1But: LoadRecords(GetWindowStr(hDataEdit));
ID_SaveVar1But: SaveVarData(GetWindowStr(hVarEdit));
ID_LoadVar1But: LoadVarData(GetWindowStr(hVarEdit));
ID_SaveStrBut: SaveStringRecs;
ID_GetListBut: LoadListBox;
ID_LoadStrBut: Load1StringRec;
end;
end;
end;
procedure GetTabInfo;
var
TabInfo: TTCItem;
aryChar: Array[Zero..31] of Char;
begin
// this gets the text and LParam for the second tab
TabInfo.mask := TCIF_TEXT or TCIF_PARAM;
TabInfo.pszText := @aryChar;
TabInfo.cchTextMax := 32;
SendMessage(hTab1, TCM_GETITEM, One, Integer(@TabInfo));
MessageBox(hForm1, PChar(TabInfo.pszText+', lParam '+Int2Str(TabInfo.lParam)),
'Tab 2 Info', MB_ICONINFORMATION);
end;
procedure SetTabInfo;
var
TabInfo: TTCItem;
Sel: Integer;
begin
TabInfo.mask := TCIF_TEXT;
TabInfo.pszText:= ' New Tab Text ';
SendMessage(hTab1, TCM_SETITEM, One, Integer(@TabInfo));
{ the TCM_SETITEM message will change the tab text and redraw the tab control.
but it will NOT redraw any child controls (the pages). It will overdraw anything
visible on the tab control. So you will have to use code (below)
to tell the system to redraw the page that is shown}
Sel := SendMessage(hTab1, TCM_GETCURSEL,Zero,Zero);
case Sel of
// I use the RedrawWindow( ) because it does child windows also
Zero: RedrawWindow(hPage1, nil,Zero, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE);
One: RedrawWindow(hPage2, nil,Zero, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE
or RDW_ALLCHILDREN);
Two: RedrawWindow(hPage3, nil,Zero, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE
or RDW_ALLCHILDREN);
end;
end;
function MessageFunc(hWnd,Msg,wParam,lParam:Integer):Integer; stdcall;
begin
Result := Zero;
case Msg of
WM_DESTROY: PostQuitMessage(Zero);
WM_NOTIFY:
begin
if (wParam = ID_TabCtrl) then // check for Tab control ID
if (PNMHdr(lParam).code = TCN_SELCHANGE) then
begin
{ the TCN_SELCHANGE signals a new tab is selected,
but you will need to get which tab this message is for
with the TCM_GETCURSEL message}
case SendMessage(hTab1, TCM_GETCURSEL,Zero,Zero) of
// show the page that is now selected
Zero: begin
ShowWindow(hPage1,SW_SHOW);
EnableWindow(GetDlgItem(hForm1, ID_LoadTBut), True);
EnableWindow(GetDlgItem(hForm1, ID_SaveTBut), True);
SetFocus(hPage1);
end;
One: begin ShowWindow(hPage2,SW_SHOW); SetFocus(hSplitEdit); end;
Two: begin ShowWindow(hPage3,SW_SHOW); SetFocus(hDataEdit); end;
end;
Exit;
end else
if (PNMHdr(lParam).code = TCN_SELCHANGING) then
begin
// the TCN_SELCHANGING signals a tab is now UN-selected
case SendMessage(hTab1, TCM_GETCURSEL,Zero,Zero) of
// hide the page that is now Un-selected
Zero: begin
ShowWindow(hPage1,SW_HIDE);
EnableWindow(GetDlgItem(hForm1, ID_LoadTBut), False);
EnableWindow(GetDlgItem(hForm1, ID_SaveTBut), False);
end;
One: ShowWindow(hPage2,SW_HIDE);
Two: ShowWindow(hPage3,SW_HIDE);
end;
Exit;
end;
end;
WM_COMMAND: case LOWORD(wParam) of
ID_ExitBut: PostMessage(hForm1, WM_CLOSE, Zero, Zero);
ID_LoadTBut: LoadTextFile; // loads a text file into the edit
ID_SaveTBut: SaveTextFile; // saves a Text file from the edit
ID_TabGetBut: GetTabInfo; // gets some tab information
ID_TabSetBut: SetTabInfo;
end;
end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;
procedure MakePage2(tabRect1: TRect);
var
pSpecialDir : PItemIdList;
hNew: Integer;
TabInfo: TTCItem;
begin
{ for a "Page" in the Tab Control, I will create and use a container window.
Page 2 is a system STATIC control, but I use it as a container window, NOT
as a static window, so I sub-class it to get the button clicks.
I placed the WS_EX_CONTROLPARENT ex-style in this so Tab key press will move focus}
hPage2 := CreateWindowEx(WS_EX_CONTROLPARENT, 'STATIC', 'Page2', WS_CHILD or WS_BORDER,
TabRect1.Left,TabRect1.Top, TabRect1.Right, TabRect1.Bottom,
hTab1, 44, hInstance, nil);
{This hPage2 is NOT visible because the Text Edit Page is the first shown.
And I have placed a border on it with WS_BORDER so you can see the
size of it on the Tab Control, and it's position there}
SetWindowLong(hPage2, GWL_WNDPROC, Cardinal(@Page2MsgFunc));
{ I do NOT get the system STATIC window Proc function address here
I will use the DefWndProc for this Static, since I do not want static display}
// I create buttons and edits below with hPage2 as their parent
MakeButton(246,34, 100, butHeight, 'Get File and Copy', hPage2, ID_CopyFileBut);
hSplitEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
'? Path and File Name for Split goes here', WS_VISIBLE or WS_CHILD or
ES_AUTOHSCROLL or WS_TABSTOP, 6, 114, 506, 22,hPage2, Zero,hInstance,nil);
SendMessage(hSplitEdit,WM_SETFONT,VarFont, Zero);
MakeButton(518,114, 80, butHeight, 'Get File to Split', hPage2, ID_OpenSplitBut);
// below I create 2 Radio buttons for split file creation options
hNew := CreateWindow('BUTTON','3 Equal Pieces Split',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT,
6,140,116,21,hPage2,ID_EqualRB,hInstance,nil);
SendMessage(hNew,WM_SETFONT,VarFont,Zero);
SendMessage(hNew, BM_SETCHECK, One, Zero);
SendMessage(CreateWindow('BUTTON','1 Megabyte Split',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT or WS_GROUP,
6,163,98,21,hPage2,ID_1MegRB,hInstance,nil),WM_SETFONT,VarFont,Zero);
MakeButton(144,148, 82, butHeight, 'Start Split File', hPage2, ID_SplitBut);
{ Below is code to get the Personal Folder file path (known as My Documents)
for the current user and put the path in the PersonalFolder string.
It requires the Shell function SHGetSpecialFolderLocation( ) }
SHGetSpecialFolderLocation(hForm1, CSIDL_PERSONAL, pSpecialDir);
{there are several folders recorded in the system for each User, that the
SHGetSpecialFolderLocation function can get the path for,
like CSIDL_PROGRAMS or CSIDL_SENDTO }
SetLength(PersonalFolder, 1023);
PersonalFolder[1] := #0;
{you will need to get a text path from the PItemIdList
with SHGetPathFromIDList. Remember, it is posible that there
is NO personal folder registered for this user}
SHGetPathFromIDList(pSpecialDir, PChar(PersonalFolder));
// now PersonalFolder has the file path to folder, if registered
CoTaskMemFree(pSpecialDir);
// ALWAYS Free any PItemIdList you get from the system
SetLength(PersonalFolder, PCharLength(PChar(PersonalFolder)));
// Always find out if the special folder Exists on disk
if (Length(PersonalFolder) < 4) or (not DirectoryExists(PersonalFolder)) then
PersonalFolder := 'C:\';
hFolderEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
PChar(PersonalFolder), WS_VISIBLE or WS_CHILD or ES_AUTOHSCROLL or WS_TABSTOP,
6, 214, 490, 22,hPage2, Zero,hInstance,nil);
SendMessage(hFolderEdit,WM_SETFONT,VarFont, Zero);
hRestEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
'? Path and File Name for Restore goes here', WS_VISIBLE or WS_CHILD or
ES_AUTOHSCROLL or WS_TABSTOP, 6, 298, 490, 22,hPage2, Zero,hInstance,nil);
SendMessage(hRestEdit,WM_SETFONT,VarFont, Zero);
MakeButton(502,298, 96, butHeight, 'Get File to Restore', hPage2, ID_OpenResBut);
MakeButton(6,326, 98, butHeight, 'Start Restore File', hPage2, ID_RestoreBut);
{the next code is just for an example of making a Tab Control with Buttons.
Include the TCS_BUTTONS flag to get buttons on a Tab Control.
This tab button control does not do anything}
hButTab := CreateWindowEx(WS_EX_LEFT, WC_TABCONTROL, nil,
TCS_BUTTONS or WS_CHILD or WS_BORDER or WS_TABSTOP or
WS_CLIPSIBLINGS or WS_VISIBLE or TCS_HOTTRACK,
{181,332}427,12, 170, butHeight, hPage2, Zero, hInstance,nil);
SendMessage(hButTab,WM_SETFONT,VarFont,Zero);
TabInfo.mask := TCIF_TEXT or TCIF_PARAM;
// the mask tells the system which members of the TTCItem to read and use
TabInfo.pszText:= ' First ';
// the pszText is a PChar that will set the Text on the tab item
TabInfo.lParam:= 200;
SendMessage(hButTab, TCM_INSERTITEM, Zero, Integer(@TabInfo));
TabInfo.pszText:= ' Second ';
TabInfo.lParam:= 201;
SendMessage(hButTab, TCM_INSERTITEM, One, Integer(@TabInfo));
TabInfo.pszText:= ' Button 3 ';
TabInfo.lParam:= 202;
SendMessage(hButTab, TCM_INSERTITEM, Two, Integer(@TabInfo));
end;
procedure MakePage3(tabRect1: TRect);
var
sDC: Cardinal;
pStr: PChar;
Size1: TSize;
begin
{ Page 3 is a "Panel" window that is a container window to show and hide as
a page in the Tab Control}
hPage3 := MakePanel(tabRect1.Left,tabRect1.Top, tabRect1.Right,
tabRect1.Bottom, hTab1, PanelFunc1, 55, psTab);
// MakePanel function is in the MakeApp.pas unit
ShowWindow(hPage3, SW_HIDE);
// hide the panel because the Text Edit page is the first to show
// I create buttons and Edits as children of hPage3
MakeButton(170,28, 118, butHeight, 'Save Fixed Data File', hPage3, ID_SaveFixedBut);
MakeButton(314,28, 118, butHeight, 'Load Fixed Data File', hPage3, ID_LoadFixedBut);
MakeButton(491,64, 110, butHeight, 'Get Data File Name', hPage3, ID_DataNameBut);
hDataEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
'? Path and Data File Name for Data Array File goes here',
WS_VISIBLE or WS_CHILD or ES_AUTOHSCROLL or WS_TABSTOP,
6, 66, 480, 21,hPage3, Zero, hInstance,nil);
SendMessage(hDataEdit,WM_SETFONT,VarFont, Zero);
// the next code will get the text width for a 61 character string in a fixed width font
GetMem(pStr, 62);
FillChar(pStr^, 61, 'k');
pStr[61] := #0;
sDC := GetDC(Zero);
SelectObject(sDC, Font2); // Font2 is a fixed width font
GetTextExtentPoint32(sDC, pStr, 61, Size1);
{ I make this EDIT the width needed to display 61 text characters
this edit is used to set text in a 63 length fixed string, so it can not have
more than 63 charaters in it, it can not have the ES_AUTOHSCROLL }
hStrEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
'63 Character Fixed String Data for Array Goes Here',
WS_VISIBLE or WS_CHILD or WS_TABSTOP,
6, 106, Size1.cx+6, Size1.cy+6,hPage3, Zero, hInstance,nil);
SendMessage(hStrEdit,WM_SETFONT,Font2, Zero);
GetTextExtentPoint32(sDC, pStr, 9, Size1);
ReleaseDC(Zero, sDC);
FreeMem(pStr);
{ this Edit will get a number as text for a Cardinal variable,
so I make it wide enough for 9 text charaters}
hIntEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
'12345', WS_VISIBLE or WS_CHILD or ES_NUMBER or WS_TABSTOP, 6, 136,
Size1.cx+7, Size1.cy+6,hPage3, Zero, hInstance,nil);
SendMessage(hIntEdit,WM_SETFONT,Font2, Zero);
MakeButton(170,138, 118, butHeight, 'Save Data Array File', hPage3, ID_SaveData1But);
MakeButton(314,138, 118, butHeight, 'Load Data Array File', hPage3, ID_LoadData1But);
hVarEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT',
PChar(PersonalFolder+'\varData1.vsdf'), WS_VISIBLE or WS_CHILD or
ES_AUTOHSCROLL or WS_TABSTOP, 6, 216, 480, 21,hPage3, Zero, hInstance,nil);
SendMessage(hVarEdit,WM_SETFONT,VarFont, Zero);
MakeButton(12,237, 124, butHeight, 'Save Variable Data File', hPage3, ID_SaveVar1But);
MakeButton(150,237, 124, butHeight, 'Load Variable Data File', hPage3, ID_LoadVar1But);
MakeButton(214,278, 120, butHeight, 'Make a Text Rec File', hPage3, ID_SaveStrBut);
MakeButton(210,310, 128, butHeight, 'Get List from File Header', hPage3, ID_GetListBut);
MakeButton(214,342, 120, butHeight, '<-- Load Text from List', hPage3, ID_LoadStrBut);
// list box below displays a list of text strings in a file
hListBox := MakeListBox(4,282,200,90,hPage3,#255'No File Loaded'#0#0,
WS_VISIBLE or WS_CHILD or LBS_NOTIFY
or WS_VSCROLL or WS_CLIPSIBLINGS or WS_TABSTOP or WS_DISABLED);
hEdit2 := CreateWindowEx(WS_EX_CLIENTEDGE,'EDIT',nil,
WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOVSCROLL {or WS_VSCROLL or WS_HSCROLL} or
ES_MULTILINE, 364,278, 230, 88,hPage3,Zero,hInstance,nil);
SendMessage(hEdit2,WM_SETFONT,VarFont,Zero);
end;
procedure MakeControls;
var
TabInfo: TTCItem;
tabRect: TRect;
begin
// sFileSize is the string to draw that has the File Size for file splits
sFileSize := 'no split file';
// MakeFont is in the MakeApp unit
Font1 := MakeFont(-15, 10, 'Arial', True);
Font2 := MakeFont(-13, Zero, 'Courier New');
Font3 := MakeFont(-13, Zero, 'Times New Roman', True);
GetClientRect(hForm1, TabRect);
{ TabRect will be used for control placement and Tab page sizes
I stsrt with the TabRect as the Form's Client Rect }
TabRect.Bottom := TabRect.Bottom - 30;
// MakeButton is in the MakeApp unit
MakeButton(TabRect.Right-94,TabRect.Bottom,
84, butHeight, 'E X I T', hForm1, ID_ExitBut, Font1);
MakeButton(6,TabRect.Bottom, 84, butHeight, 'Load Text File', hForm1, ID_LoadTBut);
MakeButton(110,TabRect.Bottom, 84, butHeight, 'Save Text File', hForm1, ID_SaveTBut);
MakeButton(300,TabRect.Bottom, 76, butHeight, 'Get Tab Info', hForm1, ID_TabGetBut);
MakeButton(386,TabRect.Bottom, 76, butHeight, 'Set Tab Info', hForm1, ID_TabSetBut);
// Next is code for the Tab Control / / /
SetRect(TabRect, 4, One, TabRect.Right - 8, TabRect.Bottom -12);
{I adjust the TabRect (the Client Rect of hForm1) to have a 4 pixel space on the
left and right of the Tab control, and a 42 pixel space below it for the buttons}
{the Tab control creation has the WS_EX_CONTROLPARENT to pass the Tab messages.
I also have the TCS_HOTTRACK style bit, so mouse tracking is enabled}
hTab1 := CreateWindowEx(WS_EX_CONTROLPARENT, WC_TABCONTROL, nil,
WS_VISIBLE or WS_CHILD or BS_NOTIFY or WS_TABSTOP or
WS_CLIPSIBLINGS or TCS_HOTTRACK or WS_CLIPCHILDREN,
TabRect.Left,TabRect.Top, TabRect.Right, TabRect.Bottom,
hForm1, ID_TabCtrl, hInstance,nil);
{the WC_TABCONTROL constant is for the text 'SysTabControl32' }
SendMessage(hTab1,WM_SETFONT,Font3,Zero);
// be sure to set the tab font before you call TabCtrl_AdjustRect
{ to Add Tabs, you must set the TTCItem record, TabInfo, for the new item (tab) }
with TabInfo do
begin
// this will add three tabs to tab control
mask := TCIF_TEXT or TCIF_PARAM;
// the mask tells the system which members of the TTCItem to read and use
pszText:= ' Text Editor ';
// the pszText is a PChar that will set the Text on the tab item
lParam:= 100;
{ the lParam is a user defined integer that you can use to
store information for each separate tab}
//Place a new tab (item) in hTab1 with a TCM_INSERTITEM in SendMessage( )
SendMessage(hTab1, TCM_INSERTITEM, Zero, Integer(@TabInfo));
pszText:= ' Split a File '; // second tab item
lParam:= 101;
SendMessage(hTab1, TCM_INSERTITEM, One, Integer(@TabInfo));
pszText:= ' Save Data to File '; // third tab item
lParam:= 102;
SendMessage(hTab1, TCM_INSERTITEM, Two, Integer(@TabInfo));
end;
GetClientRect(hTab1, TabRect);
TabCtrl_AdjustRect(hTab1, False, @TabRect);
{ the TabCtrl_AdjustRect is suppose to set the rectangle to the correct
size of the "Page" area for the Tab Control. It is close, but I found it
nessary increase the width and decrease the height to get the correct size
I needed for pages. The next SetRect( ) does this}
SetRect(TabRect, TabRect.Left-Two, TabRect.Top+One,
(TabRect.Right+Two) - TabRect.Left, TabRect.Bottom -(TabRect.Top+One));
{you might like the tab page size that TabCtrl_AdjustRect gives you, or
my adjustment of that page size, or you may want to do your own size}
{I will create three controls as Pages for the Tab control, these controls
will be a child of the hTab1 and 2 are "Container" windows. A Tab control does
NOT have any pages that are changed with the selection of a Tab, so you will
need to show and hide the 3 page controls when the Tab selection changes.
This will hide and show all of the controls these pages contain.
Since the Tab control does not change pages, you will need to get the
WM_NOTIFY message and change them in the TCN_SELCHANGE notify}
{Page one is just a multi-line Edit}
hPage1 := CreateWindowEx(WS_EX_CLIENTEDGE,'Edit','Type Text Here ->',
WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOVSCROLL or WS_VSCROLL or WS_HSCROLL or
ES_MULTILINE, TabRect.Left,TabRect.Top, TabRect.Right,
TabRect.Bottom,hTab1,Zero,hInstance,nil);
SendMessage(hPage1,WM_SETFONT,Font2,Zero);
pPageProc := Pointer(SetWindowLong(hPage1, GWL_WNDPROC, Integer(@PageFunc)));
// sub-class hPage1 to get tab keys
// MakePage2 procedure creates the second page for splitting a file
MakePage2(tabRect);
// MakePage3 procedure creates the third page for multi-Data files
MakePage3(tabRect);
SetFocus(hPage1);
end;
function MakeProgram: Boolean;
begin
Result := False;
// SetWinClass and MakeForm are in the MakeApp unit
if SetWinClass('FilesU Class', @MessageFunc) = Zero then Exit;
hForm1 := MakeForm(DEF, DEF, 620, 443, 'Read and Write Files');
if hForm1 = Zero then Exit;
Result := True;
MakeControls;
end;
initialization
finalization
DeleteObject(Font1);
DeleteObject(Font2);
DeleteObject(Font3);
end. |
SplitFilesU Unit This is the code that is used for the file split operations of page two. It has three procedures that use files, the CopyFile , the StartSplit( ) , and the StartRestore procedures. The file operations in this unit create files, one for reading and another for writting. After the files are created with CreateFile( ), a while loop will be executed which will read a "Chunk" size (512 bytes) section of the read file and then write this to the write file. The CopyFile procedure will copy the entire read file to another file. I have code in this unit for the operation of dividing (Split) a File into smaller pieces as new files, and then code for a file "Restore" (rebuild), to read these new smaller files and and write a new "Whole" file as the restored original file. The StartSplit( ) procedure will get a file path and name to open as a read file, that will be divided (split) into smaller files. There are two options for this split file a "3 Piece" split or a "One Megabyte" split, which is controlled by the radio buttons on page two. The code for the 3 piece split is in the Split3Pieces( ) procedure, this always divides the file into 3 equal size pieces. This is the basic code for a simple file split that just copies bytes to another file, it does Not add any file header to the split file pieces. The code for a "One Megabyte" split is in the Split1Meg( ) procedure. This uses the same method for coping bytes from one file to another that the Split3Pieces( ) procedure used. But in this procedure I place a "File Header" on the first file split piece, to introduce you to working with a file header. This file header has five members, the FileID, the numPieces, the NameLength, the FileName, and the CreateTime. The FileID is the file Identifier, used to mark this file as a certain kind of file (one meg split). The numPieces is used to record the amount of files created as "File Pieces" for this One Megabyte split. The NameLength is required to record the number of bytes in the FileName string, so when you read the FileName out of the file you can read the correct amount of bytes. I record the original "File Name" for the file in the string FileName. The CreateTime is used to record the original file's time of creation, which is read for the "Restore File" operation and given to the new file. The StartRestore( ) procedure will get a file name from an edit, and rebuild a new "Whole File" from the files (smaller piece files), which is a copy of the original file that was split. The code that restrores a "3 piece split" is in the Restore3Pieces( ) procedure and the code for a "One Megabyte Restore" is in the Restore1Meg( ) procedure. |
unit SplitFilesU;
interface
procedure CopyAFile;
{the CopyAFile procedure is your basic code to Copy a file}
procedure StartSplit(const InFile: String);
{the StartSplit procedure will take a file path and name, and then divide
(split) that file into smaller files
The Split3Pieces( ) and Split1Meg( ) procedures do the file splits}
procedure StartRestore(const InFile: String);
{the StartRestore procedure will take a file path and name for the first
piece of a file split and combine (restore) the file pieces back to the
orriginal file}
implementation
uses
MakeApp, Windows, Messages, UseFilesU, SmallUtils;
const
// FileID is a safety Identifier for 1 Meg split files
FileID: Cardinal = $C2FAD1;
// ChunkSize is the memory block size used for file data transfers
// ChunkSize is 512 (hex 200) because it will give faster performance
ChunkSize: Cardinal = $200;
// Meg is a One megabyte constant
Meg: Cardinal = $100000;
{ All of the file work below is based on opening two files, one to read from
and one to write to. Then all of these will do a "While" loop, that will
read "ChunkSize" bytes from the read file and then writes these bytes to
the write file.
The first procedure is the CopyAFile procedure below, which shows an
Open and Save dialog box to get file names, and then copies an entire
file to another location.}
procedure CopyAFile;
var
ReadName, WriteName: String;
hFileRead, hFileWrite, Size1, BytesRead, BytesWrite: Cardinal;
BadFile: Boolean;
pBufMem: Pointer;
FileTime1: TFileTime;
begin
ReadName := OpenDialog1(5);
// ReadName is the file name to copy from
if ReadName = '' then Exit;
WriteName := OpenDialog1(6);
// WriteName is the file name for the copy of the file
if WriteName = '' then Exit;
hFileRead := CreateFile(PChar(ReadName),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN, Zero);
// the hFileRead will be used to read the bytes from
if hFileRead = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+ReadName, CreateErrTitle);
Exit;
end;
Size1 := GetFileSize(hFileRead, @BytesWrite);
if (Size1 = MaxDWord) or (BytesWrite <> Zero) then
begin // test the file size for larger than 4 gigs
CloseHandle(hFileRead);
MessageBox(hForm1, PChar('ERROR - FileSize is to large for copy'#10+ReadName),
'ERROR - Did not Create File', MB_ICONERROR);
Exit;
end;
hFileWrite := CreateFile(PChar(WriteName),GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
// hFileWrite is the Copied file where the bytes from hFileRead are written
if hFileWrite = INVALID_HANDLE_VALUE then
begin
CloseHandle(hFileRead);
SysErrorMsg(CreateErrText+#10+WriteName, CreateErrTitle);
Exit;
end;
if Size1 = 0 then
begin
CloseHandle(hFileRead);
CloseHandle(hFileWrite);
Exit; // if there are no bytes to read then Exit
end;
{ pBufMem is the byte Storage area (buffer) of memory
used to hold the data transfered from read file to write file}
GetMem(pBufMem, ChunkSize);
BadFile := False; // BadFile is used to delete a bad copy file
while Size1 > Zero do
begin { Keep reading and writing bytes until all bytes are copied.
ChunkSize is used for the amount to read, if there are less than ChunkSize
bytes to read, then ReadFile will only read the amount of bytes left,
it will NOT read past the end of the file. BytesRead will have the correct
amount of bytes acually read from the file. }
if (not ReadFile(hFileRead,pBufMem^,ChunkSize,BytesRead,nil)) then
begin
SysErrorMsg(ReadErrText, ReadErrTitle);
BadFile := True;
Break;
end;
if BytesRead = Zero then Break;
if (not WriteFile(hFileWrite,pBufMem^,BytesRead,BytesWrite, nil)) or
(BytesRead <> BytesWrite) then
begin
SysErrorMsg(WriteErrText, WriteErrTitle);
BadFile := True;
Break;
end;
Dec(Size1, BytesWrite);
end; // while loop
// to make a copy file you should get the Modified Date and set that in new file
if GetFileTime(hFileRead,nil,nil,@FileTime1) then
SetFileTime(hFileWrite,nil,nil,@FileTime1);
// Close All file handles you open
CloseHandle(hFileRead);
CloseHandle(hFileWrite);
FreeMem(pBufMem); // free your memory buffer
if BadFile then // if a file is bad then delete the file
DeleteFile(PChar(WriteName))
else
MessageBox(hForm1, PChar('Copy File is Finished, you can see the file at'#10
+WriteName),'FINISHED, Copy File', MB_ICONINFORMATION);
end;
// / / / / / / / / / / / / / / / / / / / / / / / / / / / / /
// CODE BELOW FOR FILE SPLITS
{ the StartSplit procedure below, is used to begin both the 3 piece and
One Meg file split. The large file to be split is Opened in the StartSplit
procedure, and it's handle is passed to the 2 split procedures,
Split3Pieces and Split1Meg. the Split3Pieces( ) procedure will read from
a source file and create and write to 3 destination files in a FOR LOOP,
placing one third of file Data bytes in each of the destination files}
procedure Split3Pieces(hInFile: Cardinal; var OutFile: String);
var
hChopFile, Size1, ChopSize, BytesRead,
BytesWrite, ReadSize, Total, i: Cardinal;
pBufMem: Pointer;
BadFile: BOOL;
aryFiles: Array[One..3] of String;
begin
// hInFile is the handle of the file created in the StartSplit procedure
Size1 := GetFileSize(hInFile, @ReadSize);
if (Size1 = MaxDWord) or (ReadSize <> Zero) then
begin // test the file size for larger than 4 gigs
CloseHandle(hInFile);
MessageBox(hForm1, 'ERROR - FileSize is to large'#10+'Over 4 Gigs',
'ERROR - Did not Create File', MB_ICONERROR);
Exit;
end;
if Size1 < 3 then
begin
// you will need at least 3 bytes in the file
CloseHandle(hInFile);
MessageBox(hForm1, 'ERROR - FileSize is to Small, must be Larger than 2 bytes',
'ERROR - Can NOT Split File', MB_ICONERROR);
Exit;
end;
{ I will use a memory buffer in pBufMem for the file byte transfers
I get a memory block of ChunkSize in pBufMem with GetMem( ) }
GetMem(pBufMem, ChunkSize);
Total := Zero; // Total will record the bytes written to file in each WriteFile
BadFile := False;
// BadFile is used if there is a file write error, to delete the files
hChopFile := Zero;
SetLength(OutFile, Length(OutFile)- One);
for i := One to 3 do // this will loop three times, and create a new file each loop
begin
if BadFile then Break;
aryFiles[i] := OutFile+Int2Str(i); // aryFiles will record file names for delete
// create file and test for valid file handle
hChopFile := CreateFile(PChar(aryFiles[i]),GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hChopFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+aryFiles[i], CreateErrTitle);
BadFile := True;
Break;
end;
{ ChopSize is the new file size, one thid of total bytes
be sure to adjust ChopSize for the last piece, using Total}
if i = 3 then
ChopSize := Size1-Total
else
ChopSize := Size1 div 3;
while ChopSize > Zero do
begin // keep Reading and writing bytes until Chopsize bytes are transfered
// you will need to adjust the ReadSize for the last file read
if ChopSize > ChunkSize then ReadSize := ChunkSize else ReadSize := ChopSize;
if (not ReadFile(hInFile,pBufMem^,ReadSize,BytesRead,nil)) or
(ReadSize <> BytesRead) then
begin
SysErrorMsg(ReadErrText, ReadErrTitle);
BadFile := True;
Break;
end;
if BytesRead = Zero then Break;
if (not WriteFile(hChopFile,pBufMem^,BytesRead,BytesWrite,nil)) or
(BytesRead <> BytesWrite) then
begin
SysErrorMsg(WriteErrText, WriteErrTitle);
BadFile := True;
Break;
end;
Dec(ChopSize, BytesWrite);
Inc(Total, BytesWrite);
end;
// Close All file handles you open
CloseHandle(hChopFile);
hChopFile := Zero;
end; // for loop
FreeMem(pBufMem);
CloseHandle(hInFile);
if hChopFile <> Zero then
CloseHandle(hChopFile);
if BadFile then
begin // if a file is bad then delete all three piece files
for Size1 := One to 3 do
DeleteFile(PChar(aryFiles[Size1]));
end else
MessageBox(hForm1, PChar('Three Piece Split is Finished, you can see the files'+
' at'#10+aryFiles[One]),'FINISHED, 3 Piece Split', MB_ICONINFORMATION);
end;
{ the Split1Meg( ) procedure will read from a source file and write
to a destination file in a FOR LOOP, placing one Meg of Data bytes
in the destination file . .
This code is almost the same as in the Split3Pieces( ) above.
I included it here because, in this one I place a "File Header"
on the first file. I think it is important to always have a "File Header"
on your files.}
procedure Split1Meg(hInFile: Cardinal; var OutFile, FileName: String);
var
hChopFile, Size1, ChopSize, BytesRead,
BytesWrite, ReadSize, Total, numPieces, HeaderSize, i: Cardinal;
NameLength: Word;
BadFile: Bool;
pMemBuf: Pointer;
CreateTime: TFileTime;
function tryWrite(var Source; Size: Cardinal; opPos: Integer): Bool;
begin
{because WriteFile needs to be called many times, I placed it in this function.
This function will Write the File and test for a file write Error}
if WriteFile(hChopFile,Source,Size,BytesWrite,nil) and (BytesWrite = Size) then
Result := False // Result is False for a Successful Write
else
begin
Result := True;
// a Result of True will end the file split
BadFile := True;
// BadFile as True will delete destination file
SysErrorMsg(WriteErrText, WriteErrTitle+' '+Int2Str(opPos));
{ show a file write Error Message
with a debug reference of where it happened in opPos}
end;
end;
begin
NameLength := Length(FileName);
if NameLength < 3 then // checks for empty string
begin
CloseHandle(hInFile);
MessageBox(hForm1, 'ERROR - File name is less than 3 characters long',
'ERROR - Can NOT Create a File', MB_ICONERROR);
Exit;
end;
Size1 := GetFileSize(hInFile, @ReadSize);
// get file size to test if it is larger than a Megabyte
if (Size1 = MaxDWord) or (ReadSize <> Zero) then
begin
CloseHandle(hInFile);
MessageBox(hForm1, 'ERROR - FileSize is incorrect, to large'#10'Over 4 Gigs',
'ERROR - Can NOT Split File', MB_ICONERROR);
Exit;
end;
if Size1 <= Meg then
begin
CloseHandle(hInFile);
MessageBox(hForm1, 'ERROR - FileSize is to Small, must be Larger than a Megabyte',
'ERROR - Can NOT Split File', MB_ICONERROR);
Exit;
end;
// these created files will have a File Header with the file name in it
HeaderSize := SizeOf(FileID) + SizeOf(numPieces) + SizeOf(NameLength) +
NameLength + SizeOf(CreateTime);
{ HeaderSize is the amount of bytes added as the file header in the
first file piece. This header has 2 Cardinals (FileID, numPieces),
a Word (NameLength), and a TFileTime (CreateTime), which is 18 bytes,
and the number of text characters in FileName, NameLength}
Size1 := Size1 + HeaderSize;
// Add the HeaderSize to the Size1 to get the total size of bytes for split.
numPieces := Size1 div Meg;
// you need to find out how may new files to create
if Size1 mod Meg <> Zero then
Inc(numPieces);
GetMem(pMemBuf, ChunkSize);
{ I will use a ChunkSize memory Buffer to get and transfer the file bytes in the
read and write operations. A ChunkSize of $200 seems to give the best performance
You should experiment with different chunk sizes to see what difference it makes}
try // try is here so finally will call FreeMem( )
Total := HeaderSize; // Total will record the amount read from the source file
BadFile := False;
for i := One to numPieces do // FOR LOOP for each file piece
begin
if BadFile then Break;
// OutFile if the file Path and Name for each piece
SetLength(OutFile, Length(OutFile)- Length(Int2Str(i-One)));
OutFile := OutFile+Int2Str(i); // add the Piece Number to the file name
hChopFile := CreateFile(PChar(OutFile),GENERIC_WRITE,Zero,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hChopFile = INVALID_HANDLE_VALUE then
begin
CloseHandle(hInFile);
SysErrorMsg(CreateErrText+#10+OutFile, CreateErrTitle);
Exit;
// pBufMem freed in the finally
end;
if i = numPieces then
ChopSize := Size1-Total // last piece will be smaller than a Meg
else
ChopSize := Meg;
{File Headers are an important and widely used way to store data for identifing
and using the bytes in a file. You must be able to place the information you
need for using a file, in it's file Header}
if i = One then // only for the first piece, add a File header
begin
if tryWrite(FileID, SizeOf(FileID), -1) then Exit;
{ I add a File Identification number for safty, since there may be other
files with the .1m1 file extentions}
if tryWrite(numPieces, SizeOf(numPieces), -2) then Exit;
// I must add the Number of file Pieces, to use when restoring this file
if tryWrite(NameLength, SizeOf(NameLength), -3) then Exit;
// For all text in a file, you will need to write its character length to file
if tryWrite(FileName[One], NameLength, -4) then Exit;
{ you can NOT use the SizeOf( ) function for text strings.
I use a reference to the first character in the FileName string,
this will write the NameLength number of characters to file}
GetFileTime(hInFile, nil, nil, @CreateTime);
if tryWrite(CreateTime, SizeOf(CreateTime), -5) then Exit;
ChopSize := Meg - HeaderSize;//(NameLength + HeaderSize);
// you will need to change the ChopSize in order to get a one Meg file
end;
while ChopSize > Zero do
begin
if ChopSize > ChunkSize then ReadSize := ChunkSize else ReadSize := ChopSize;
if not ReadFile(hInFile,pMemBuf^,ReadSize,BytesRead,nil) or
(ReadSize <> BytesRead) then
begin
SysErrorMsg(ReadErrText, ReadErrTitle+' '+Int2Str(i));
BadFile := True;
Exit;
end;
if BytesRead = Zero then Break;
{this while loop is like the one above in the Split3Pieces procedure.
But now I have added the tryWrite function, which will test the
file write operation for success and return True if there i a failure}
if tryWrite(pMemBuf^, BytesRead, i) then Exit;
Dec(ChopSize, BytesWrite);
// I record the Total bytes written to the file
Inc(Total, BytesWrite);
end;
CloseHandle(hChopFile);
hChopFile := Zero
end; // while loop
finally
FreeMem(pMemBuf);
CloseHandle(hInFile);
if hChopFile <> Zero then
CloseHandle(hChopFile);
end;
if not BadFile then // I do not delete the bad files created
MessageBox(hForm1, PChar('One Meg Split is Finished, you can see the files at'#10+
OutFile),'FINISHED, 3 Piece Split', MB_ICONINFORMATION);
end;
procedure StartSplit(const InFile: String);
var
hReadFile: Cardinal;
FileName, OutFile: String;
begin
// get the file path and name from the hSplitEdit edit box
if (InFile = '') or (InFile[One] = '?') or (not FileExists(InFile)) then
begin
MessageBox(hForm1, 'ERROR - You must Have a valid File Path and Name in the'+
'File to Split Edit box', 'ERROR - Not a Valid File', MB_ICONERROR);
Exit;
end;
FileName := InFile;
OutFile := GetSplitFolder;
// get the uotput folder from the hFolderEdit edit box
if OutFile = '' then Exit;
if OutFile[Length(OutFile)] <> '\' then
OutFile := OutFile+'\'; // check for back slash
// get the OutFile path and name by adding the file name to the OutFile path
OutFile := OutFile+GetFileName(FileName);
hReadFile := CreateFile(PChar(FileName),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
// the hReadFile created above will be used in both the Split3Pieces and Split1Meg
if hReadFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+FileName, CreateErrTitle);
Exit;
end;
if SendDlgItemMessage(hPage2, ID_1MegRB, BM_GETCHECK,Zero,Zero) = BST_CHECKED then
begin
SetLength(OutFile, Length(OutFile)- Length(GetFileExt(OutFile)));
// chop off the file extention for the OutFile and add the split piece extention
OutFile := OutFile+'.1meg0';
FileName := GetFileName(FileName);
Split1Meg(hReadFile, OutFile, FileName);
end else
begin
OutFile := OutFile+'.3p0';
Split3Pieces(hReadFile, OutFile);
end;
end;
// / / / File Restore Code / / / / / / / / / / / / /
{procedure Restore3Pieces( ) will open and read 3 split files, and create and
write a "Whole" file from the pieces}
procedure Restore3Pieces(var SplitName, OutFile: String);
var
hSplitFile, hWholeFile, Size1, ReadSize, BytesRead, BytesWrite, i: Cardinal;
pBufMem: Pointer;
BadFile: BOOL;
begin
// Create a file, hWholeFile, to write all of the pieces to
hWholeFile := CreateFile(PChar(OutFile),GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hWholeFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+OutFile, CreateErrTitle);
Exit;
end;
GetMem(pBufMem, ChunkSize);
// pBufMem is the memory block the file byte transfer will be stored into
hSplitFile := Zero;
BadFile := False;
for i := One to 3 do
begin
if BadFile then Break;
// set the last file extention character to the piece number
SplitName[Length(SplitName)] := Int2Str(i)[1];
hSplitFile := CreateFile(PChar(SplitName),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
// open 3 split piece files in this loop to read bytes from
if hSplitFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+SplitName, CreateErrTitle);
CloseHandle(hWholeFile);
Exit;
end;
Size1 := GetFileSize(hSplitFile, @ReadSize);
while Size1 > Zero do
begin
// Size1 is tested to see if the file piece is at the end of it's bytes
if Size1 > ChunkSize then ReadSize := ChunkSize else ReadSize := Size1;
// ReadSize will be ChunkSize untill there are less bytes left in the file
if (not ReadFile(hSplitFile,pBufMem^,ReadSize,BytesRead,nil)) or
(ReadSize <> BytesRead) then
begin
SysErrorMsg(ReadErrText, ReadErrTitle);
BadFile := True;
Break;
end;
// stop loop if there are no bytes read from file
if BytesRead = Zero then Break;
// test file write and the amount written to file
if (not WriteFile(hWholeFile, pBufMem^, BytesRead, BytesWrite, nil)) or
(BytesRead <> BytesWrite) then
begin
SysErrorMsg(WriteErrText, WriteErrTitle);
BadFile := True;
Break;
end;
Dec(Size1, BytesWrite);
end; // while loop
CloseHandle(hSplitFile);
hSplitFile := Zero;
end; // for loop
FreeMem(pBufMem);
CloseHandle(hWholeFile);
if hSplitFile <> Zero then
CloseHandle(hSplitFile);
// if there is a read or write error, with BadFile = true, then delete OutFile
if BadFile then
DeleteFile(PChar(OutFile))
else
MessageBox(hForm1, PChar('Three Piece Restore is Finished, you can see the'+
' files at'#10+OutFile),'FINISHED, 3 Piece Split', MB_ICONINFORMATION);
end;
{Restore1Meg procedure will read the file header of the first 1 Meg file piece
and then combine the files together}
procedure Restore1Meg(var SplitName, OutFolder: String);
var
hSplitFile, hWholeFile, Size1, ReadSize, BytesRead,
BytesWrite, numPieces, HeaderSize, i: Cardinal;
NameLength: Word;
pBufMem: Pointer;
FileName: String;
CreateTime: TFileTime;
BadFile: BOOL;
function tryRead(var Dest; Size: Cardinal; opPos: Integer): Bool;
begin
if ReadFile(hSplitFile,Dest, Size, BytesRead,nil) and (Size = BytesRead) then
Result := False
else
begin
// the opPos will tell you at which operation the error happened
SysErrorMsg(ReadErrText, ReadErrTitle+' '+Int2Str(opPos));
CloseHandle(hSplitFile);
BadFile := True;
Result := True;
end;
end;
begin
// this is like the 3 piece restore, except I read the file header for One Meg split
hSplitFile := CreateFile(PChar(SplitName),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hSplitFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+SplitName, CreateErrTitle);
Exit;
end;
Size1 := GetFileSize(hSplitFile, @ReadSize);
if Size1 <> Meg then
begin
CloseHandle(hSplitFile);
MessageBox(hForm1, 'ERROR Meg - This is NOT a valid One Meg Split File',
'ERROR - Not a Valid Split File', MB_ICONERROR);
Exit;
end;
if tryRead(i, SizeOf(i), -1) then Exit;
// this is where I read the file header from the first file piece
if i <> FileID then
begin
// make sure the File ID is correct
CloseHandle(hSplitFile);
MessageBox(hForm1, 'ERROR FileID - This is NOT a valid One Meg Split File ',
'ERROR - Not a Valid Split File', MB_ICONERROR);
Exit;
end;
if tryRead(numPieces, SizeOf(numPieces), -2) then Exit;
{ all of the file header data is read out of the file in the same order it was
written to the file in the Split1Meg( ) procedure above}
if tryRead(NameLength, SizeOf(NameLength), -3) then Exit;
SetLength(FileName, NameLength);
{for any String text data you must read the number of bytes in the string first
and then set the string length so you can read the bytes from file}
if tryRead(FileName[One], NameLength, -4) then Exit;
FileName := OutFolder+FileName;
if tryRead(CreateTime, SizeOf(CreateTime), -5) then Exit;
hWholeFile := CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
{the hWholeFile is the file that is written to, with the bytes of the file pieces}
if hWholeFile = INVALID_HANDLE_VALUE then
begin
CloseHandle(hSplitFile);
SysErrorMsg(CreateErrText+#10+FileName, CreateErrTitle);
Exit;
end;
// you must get the number of bytes used for the header and subtract it from Size1
HeaderSize := SizeOf(FileID) + SizeOf(numPieces) + SizeOf(NameLength) +
NameLength + SizeOf(CreateTime);
Size1 := Size1 - HeaderSize;
GetMem(pBufMem, ChunkSize);
BadFile := False;
for i := One to NumPieces do // start from one
begin
if BadFile then Break;
if i > One then
begin
// the first split piece was created before this FOR loop
SetLength(SplitName, Length(SplitName)- Length(Int2Str(i-One)));
// the next split file name is built from the SplitName and the i loop counter
SplitName := SplitName+Int2Str(i);
hSplitFile := CreateFile(PChar(SplitName),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hSplitFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+SplitName, CreateErrTitle);
BadFile := True;
Break;
end;
Size1 := GetFileSize(hSplitFile, @ReadSize);
end;
while Size1 > Zero do
begin
// loop untill Size1 bytes are copied
if Size1 > ChunkSize then // set the ReadSize
ReadSize := ChunkSize
else
ReadSize := Size1;
if tryRead(pBufMem^,ReadSize, i) then Break;
if BytesRead = Zero then Break;
if (not WriteFile(hWholeFile,pBufMem^,BytesRead,BytesWrite,nil)) or
(BytesRead <> BytesWrite) then
begin
SysErrorMsg(WriteErrText, WriteErrTitle);
BadFile := True;
Break;
end;
Dec(Size1, BytesWrite); // reduce Size1 to track the number of bytes written
end;
CloseHandle(hSplitFile);
hSplitFile := Zero;
end;
FreeMem(pBufMem);
SetFileTime(hWholeFile, nil, nil, @CreateTime);
CloseHandle(hWholeFile);
if hSplitFile <> Zero then
CloseHandle(hSplitFile);
if BadFile then
DeleteFile(PChar(FileName)) // delete the bad file
else
MessageBox(hForm1, PChar('One Meg Restore is Finished, you can see the files at'#10+
FileName),'FINISHED, 1 meg Restore', MB_ICONINFORMATION);
end;
{this StartRestore takes the file path and name of the first file piece, and
will test the file name extention and call Restore3Pieces or Restore1Meg }
procedure StartRestore(const InFile: String);
var
FileName, OutFile, Ext1: String;
begin
// test for valid file name
if (InFile = '') or (InFile[One] = '?') or (not FileExists(InFile)) then
begin
MessageBox(hForm1, 'ERROR - You must Have a valid File Path and file Name in the'+
'File to Restore Edit box', 'ERROR - Not a Valid File', MB_ICONERROR);
Exit;
end;
Ext1 := UpperCase(GetFileExt(InFile));
// the file extention will determine which File restore procedure to call
OutFile := GetSplitFolder;
if OutFile = '' then Exit;
if OutFile[Length(OutFile)] <> '\' then
OutFile := OutFile+'\'; // insure there is a \
if Ext1 = '.3P1' then // 3P1 extention means it is a 3 piece restore
begin
OutFile := OutFile+GetFileName(InFile);
// build the output file name from the OutFile and the Infile strings
SetLength(OutFile, Length(OutFile)- Length(Ext1));
FileName := InFile;
Restore3Pieces(FileName, OutFile);
end else
if Ext1 = '.1MEG1' then // this is a one Meg restore
begin
FileName := InFile;
// the Restore1Meg will read the outFile file name from it's file header
Restore1Meg(FileName, OutFile);
end else
begin
MessageBox(hForm1, 'ERROR - You must Have a .3p1 or .1meg1 File Extention'+
' for the Restroe File', 'ERROR - Not a Split File', MB_ICONERROR);
Exit;
end;
end;
end. |
In this unit I try and show some methods to build files that will store several different things (variables, data bytes) in a file as sparate "Blocks" or "Segments" of data, I will call these file pieces a file "Data Segment". There will be times when you need to make a file for information "Storage", where you need to write and read many different kinds and types of data bytes in one file. Placing variables that do not change their memory allocation (Fixed-Size variable) into a file is the easiest so I start by using some "Fixed Size" variables which are written, then read to a file. You can see the code for this in the SaveFixed and LoadFixed procedures. Next there is code in the SaveRecords( ) and LoadRecords( ) procedures which show you how to save a changing number of delphi records to a file. These records are of type TDataRec which only contains "Fixed-Size" variables, which makes file writting more easy than if they contained a String variable. Next are the SaveVarData and LoadVarData procedures, which will use "Changing-Size" memory allocation variables, like a String and PChar. The important thing to see, is that since these types of variables will have a different "Byte Size" for their data blocks, depending on what text is in them, , you MUST place a number (integer) in the file to store the "Data Segment" size for every "Changing-Size" variable you write to file. Also this shows you how to write a "File Header" in the file, with a "File Type Identifier" or File ID. For any file that is read and calls for allocating memory from a number in that file, you should always have a "File Type Identifier" in the file. In the SaveStringRecs procedure, I show some methods to write 5 Records (with strings in them) to file. Unlike Fixed-Size records, you will not be able to write and read the entire record in the file with one file operation. When you write this TStrRec to file you will need to also write a number in the file for the length of the string. So you write the two fixed size variables (width , height) to file (8 bytes) and then write the string length and then the string characters. . . . In this SaveStringRecs procedure are methods to have a file header with the position and size of all the Data Segments (TStrRec) in it, so you can read the file header and get the information you need to read only one TStrRec from the file. This is a method used for random access of files that are read for only one part of the information that they have, so you do not need to read the entire file to get a single data segment. I use a THeader record as the file header information "Block" with the position, size and description for each TStrRec data segment. The LoadListBox procedure will read all of the THeader records in the file and fill a List Box control with the 5 description texts in these 5 THeader. The the user can select a description in the List Box and run the Load1StringRec procedure, which will read one THeader record (indexed from the list box), and get the position and size from this THeader , then read only one TStrRec from the file, and show the record's TextLines in the memo Edit control. |
unit DataFilesU;
interface
procedure SaveFixed;
{the SaveFixed and LoadFixed procedures will write and read a
muti-segment data file, with several fixed size variables in it}
procedure LoadFixed;
procedure SaveRecords(const OutFile: String);
{the SaveRecords and LoadRecords procedures will write and read a file
that has 8 TDataRec records in it}
procedure LoadRecords(const InFile: String);
procedure SaveVarData(const OutFile: String);
{the SaveVarData and LoadVarData procedures will write and read a file
that has some changing size variables in it}
procedure LoadVarData(const InFile: String);
procedure SaveStringRecs;
{the SaveStringRecs procedure will write a file with 5 TStrRec records
and a file header with 5 THeader records}
procedure LoadListBox;
{the LoadListBox procedure will read the file header and place the 5
THeader ListText strings in the List Box}
procedure Load1StringRec;
{the Load1StringRec will get the Index from the List Box and get just
ONE TStrRec record from the file}
implementation
uses
MakeApp, Windows, Messages, UseFilesU, SmallUtils;
type
// the TDataRec record is a Fixed Variable record placed in a file
TDataRec = packed Record
TrackNum, SomeNum: Cardinal;
aRect: TRect;
Text: String[63];
end;
// the TStrRec has a String, so you will need to write it's length to file
TStrRec = packed Record
Width, Height: Integer;
TextLines: String;
end;
{ THeader record is used in the file header, to keep file position and size of
a TStrRec record. It has list text, a description which will be shown in
a list box. Header records should only contain fixed size variables}
THeader = packed Record
Position, Size: Cardinal;
ListText: String[18];
end;
// TOrd1 is an Ordinal type written to file in the SaveFixed procedure
TOrd1 = (orFirst, orSecond, orMiddle, orNext, orLast);
const
{ FileDataID is a safety Identifier for the Var muti-data files
I use 6 text characters for this one, and a Cardinal for the next one }
FileDataID: Array[0..5] of Char = 'VSDF01'; // the '01' is the version
// FileStrID is a safety Identifier for string muti-data files
FileStrID: Cardinal = 719394801;
DataFile = 'C:\Data File 1.FixedData';
// DataFile is the file path for the Fixed Variable file
StringFile = 'C:\String File 1.StrRec';
// DataFile is the file path for the Fixed Variable file
procedure SaveFixed;
var
hFile, BytesWrite: Cardinal;
// all of the fixed size variables below will be written to one file
Int1: Integer;
Word1: Word;
Real1: Real;
aRect: TRect;
aryPnt: Array[Zero..Two] of TPoint;
aryChar: Array[Zero..15] of Char;
Str1: String[32];
Ord1: TOrd1;
setOrd: Set of TOrd1;
begin
{this procedure will write several different types of
fixed size variables to one file}
hFile := CreateFile(DataFile,GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+DataFile, CreateErrTitle);
Exit;
end;
Int1 := -12345;
Word1 := 8888;
Real1 := 987.123;
SetRect(aRect, One,Two,3,4);
aryPnt[Zero].x := 22;
aryPnt[Zero].y := 44;
aryChar := 'Array Char 16'#0;
Str1 := ' String One';
Ord1 := orNext;
setOrd := [orFirst, orMiddle, orNext];
{ the varaiables are all given values above
and all are written to file in the same way using the SizeOf( ) function below}
WriteFile(hFile,Int1,SizeOf(Int1),BytesWrite,nil);
WriteFile(hFile,Word1,SizeOf(Word1),BytesWrite,nil);
WriteFile(hFile,Real1,SizeOf(Real1),BytesWrite,nil);
WriteFile(hFile,aRect,SizeOf(aRect),BytesWrite,nil);
WriteFile(hFile,aryPnt,SizeOf(aryPnt),BytesWrite,nil);
WriteFile(hFile,aryChar,SizeOf(aryChar),BytesWrite,nil);
WriteFile(hFile,Str1,SizeOf(Str1),BytesWrite,nil);
WriteFile(hFile,Ord1,SizeOf(Ord1),BytesWrite,nil);
WriteFile(hFile,setOrd,SizeOf(setOrd),BytesWrite,nil);
BytesWrite := GetFileSize(hFile, nil);
CloseHandle(hFile);
{PLEASE NOTICE, that I do NOT test the WriteFile functions above to
see if they are successful, instead I test the file size below.
If the Size is not 105 then a write error has happened }
if BytesWrite = 105 then
MessageBox(hForm1, PChar('New FixedData File is at - '+DataFile),
'New Fixed Data File', MB_ICONERROR)
else
MessageBox(hForm1, 'ERROR - Data File is NOT the Correct Size',
'Write File Error', MB_ICONERROR);
end;
procedure LoadFixed;
var
hFile, BytesWrite, Size: Cardinal;
// variables below are read from a file
Int1: Integer;
Word1: Word;
Real1: Real;
aRect: TRect;
aryPnt: Array[Zero..Two] of TPoint;
aryChar: Array[Zero..15] of Char;
Str1: String[32];
Ord1: TOrd1;
setOrd: Set of TOrd1;
begin
{this procedure will read all of the different types of
fixed size variables above, from one file}
hFile := CreateFile(DataFile,GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+DataFile, CreateErrTitle);
Exit;
end;
Size := GetFileSize(hFile, nil);
if Size <> 105 then
begin
// check to see if the file has the correct amount of data to read
CloseHandle(hFile);
MessageBox(hForm1, 'ERROR - File is NOT the Correct Size',
'Bad File Size', MB_ICONERROR);
Exit;
end;
{ IMPORTANT ! ! There is NO information in this file about what
the bytes in this file are used for, the only reason you can read
the data in this file is because you made the code that created this file.
So you can read the bytes of this file as data into variables because you
know the order and the size of the Data Blocks that YOU wrote to this file.
All variables are read from the file with the same method.}
ReadFile(hFile,Int1,SizeOf(Int1),BytesWrite,nil);
{ you need to read the EXACT same type of variables out of the file
in the EXACT same order that you wrote them to file or you will have errors}
ReadFile(hFile,Word1,SizeOf(Word1),BytesWrite,nil);
ReadFile(hFile,Real1,SizeOf(Real1),BytesWrite,nil);
ReadFile(hFile,aRect,SizeOf(aRect),BytesWrite,nil);
ReadFile(hFile,aryPnt,SizeOf(aryPnt),BytesWrite,nil);
ReadFile(hFile,aryChar,SizeOf(aryChar),BytesWrite,nil);
ReadFile(hFile,Str1,SizeOf(Str1),BytesWrite,nil);
ReadFile(hFile,Ord1,SizeOf(Ord1),BytesWrite,nil);
ReadFile(hFile,setOrd,SizeOf(setOrd),BytesWrite,nil);
CloseHandle(hFile);
if Ord1 in setOrd then
MessageBox(hForm1, PChar('Fixed Size Data values are -'#10+Int2Str(int1)+' '+
Int2Str(aRect.Left)+' '+ Int2Str(aryPnt[Zero].x)+' '+aryChar+Str1),
'Fixed Data Read', MB_ICONINFORMATION)
else
MessageBox(hForm1, 'ERROR - Fixed Data File is NOT Correct',
'Bad File Data', MB_ICONERROR);
end;
procedure SaveRecords(const OutFile: String);
var
hFile, BytesWrite: Cardinal;
i: Integer;
aryRec1: Array of TDataRec;
BadFile: Boolean;
function tryWrite(var Source; Size: Cardinal): Bool;
begin
// this tryWrite function is called for every file write of data
if WriteFile(hFile,Source,Size,BytesWrite,nil) and (BytesWrite = Size) then
Result := False // WriteFile must succeed and the BytesWrite must equal Size
else
begin
SysErrorMsg(WriteErrText, WriteErrTitle); // show error msg
BadFile := True; // set BadFile to True to delete the new file
Result := True; // Result is True if there is a write Error
end;
end;
begin
// this procedure will create a file and write 8 records of TDataRec to the file
if Length(OutFile) < 6 then
begin
MessageBox(hForm1, 'ERROR - Data File Name must be at least 6 Charaters',
'Invalid Data File Name', MB_ICONERROR);
Exit;
end;
SetLength(aryRec1, 8);
{ get the memory for the records with SetLength( ) and
then fill the records with data in the for loop below}
for i := Zero to High(aryRec1) do
begin
aryRec1[i].TrackNum := i;
aryRec1[i].SomeNum := Str2IntDef(GetWindowStr(hIntEdit), Zero);
aryRec1[i].aRect.Left := i+One;
aryRec1[i].Text := Int2Str(i)+' '+GetWindowStr(hStrEdit);
end;
hFile := CreateFile(PChar(OutFile),GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+OutFile, CreateErrTitle);
Exit;
end;
BadFile := False; { BadFile will be set to True if there is a write Error.
for almost all file writting, you should have a way to delete the file
or fix it if there is a write error}
i := Length(aryRec1);
{there is the tryWrite( ) function above which is called when each time you
will write a data segment to file, it tests to see if the WriteFile function
was complete, and all the bytes were written,
it returns True if there is a write file Error}
if not tryWrite(i, SizeOf(i)) then
for i := Zero to High(aryRec1) do // loop through all records in array
if tryWrite(aryRec1[i], SizeOf(TDataRec)) then Break;
CloseHandle(hFile);
if BadFile then // test for BadFile and Delete the file if it is bad
begin
DeleteFile(PChar(OutFile));
MessageBox(hForm1, 'ERROR - Data File Could not be fully Written',
'ERROR, NO data File', MB_ICONERROR);
end else
MessageBox(hForm1, PChar('Data File has been Created at'#10+OutFile),
'SUCCESS, Data File Creation', MB_ICONINFORMATION);
end;
procedure LoadRecords(const InFile: String);
var
hFile: Cardinal;
i: Integer;
aryRec1: Array of TDataRec;
BytesRead: Cardinal;
BadFile: Boolean;
function tryRead(var Dest; Size: Cardinal): Bool;
begin
// this tryRead function is called for every file read of data
if ReadFile(hFile, Dest, Size, BytesRead,nil) and (Size = BytesRead) then
Result := False // returns false if succesful
else
begin
// if there is a Read Error this returns True and shows an Error Message
SysErrorMsg(ReadErrText, ReadErrTitle);
CloseHandle(hFile);
// Close Handle and set BadFile to True
BadFile := True;
Result := True;
end;
end;
begin
// this procedure will read the file made in the SaveRecords procedure above
if Length(InFile) < 6 then
begin
MessageBox(hForm1, 'ERROR - Data File Name must be at least 6 Charaters',
'Invalid Data File Name', MB_ICONERROR);
Exit;
end;
hFile := CreateFile(PChar(InFile),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+InFile, CreateErrTitle);
Exit;
end;
BadFile := False; // BadFile will be made True if there is a Read Error
if not tryRead(i, SizeOf(i)) then // get the number of records in the file
begin
SetLength(aryRec1, i); // set array length to the number of records in the file
for i := Zero to High(aryRec1) do // loop through and read all of the records
if tryRead(aryRec1[i], SizeOf(TDataRec)) then Break;
end else
BadFile := True;
CloseHandle(hFile);
if BadFile then
begin
MessageBox(hForm1, PChar('ERROR - Data File Could not be fully Read '#10+InFile),
'ERROR, NO READ data File', MB_ICONERROR);
end else
begin
SetWindowText(hStrEdit, @aryRec1[High(aryRec1)].Text[One]);
SetWindowText(hIntEdit, PChar(Int2Str(aryRec1[High(aryRec1)].SomeNum)));
MessageBox(hForm1, PChar('Data File has been Read at'#10+InFile),
'SUCCESS, Read Data File', MB_ICONINFORMATION);
end;
end;
{the SaveVarData procedure will write changing size variables to file}
procedure SaveVarData(const OutFile: String);
var
hFile: Cardinal;
DataSize: Integer;
BytesWrite: Cardinal;
Str1: String;
pText: PChar;
aryInteger: Array of Integer;
function noWrite(var Source; Size: Cardinal): Bool;
begin
// noWrite will return True if the write is NOT successful
if WriteFile(hFile,Source,Size,BytesWrite,nil) and (BytesWrite = Size) then
Result := False
else
begin
// when there is a File Write error, I close the file and delete it
CloseHandle(hFile);
DeleteFile(PChar(OutFile));
SysErrorMsg(WriteErrText, WriteErrTitle); // show Error message
Result := True;
end;
end;
begin
// OutFile is the text in the hVarEdit Edit box
if Length(OutFile) < 6 then
begin
MessageBox(hForm1, 'ERROR - Data File Name must be at least 6 Charaters',
'Invalid Data File Name', MB_ICONERROR);
Exit;
end;
// initialize all variables
Str1 := 'String Text to write and read in a file';
pText := 'More Text to use in this file';
// when the compilier creates the pText above it adds a #0 to the end
SetLength(aryInteger, 4);
aryInteger[0] := 4444444;
aryInteger[1] := 8888888;
aryInteger[2] := 1;
aryInteger[3] := -2;
hFile := CreateFile(PChar(OutFile),GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+OutFile, CreateErrTitle);
Exit;
end;
{ first I write a File type ID text to the file.
For all your data files you should have some kind of file Identifier
as the first data block in the file, so you can try and detect if this file
has the data bytes that you know how to read}
if noWrite(FileDataID, SizeOf(FileDataID)) then Exit; // 6 text chars
// if the file write of noWrite fails, then Exit
DataSize := Length(Str1); // get the size of string bytes and write it to file
if noWrite(DataSize, SizeOf(DataSize)) then Exit;
if noWrite(Str1[One], DataSize) then Exit; // write string text to file
DataSize := StrLen(pText)+1; // add one byte for the NULL char #0
if noWrite(DataSize, SizeOf(DataSize)) then Exit; // also writes the NUL char #0
if noWrite(pText^, DataSize) then Exit;
DataSize := Length(aryInteger);
if noWrite(DataSize, SizeOf(DataSize)) then Exit;// write number of integers in array
{ IMPORTANT - you MUST do the math to get the byte Size of all the Data in the array,
multiply the length of the array by the size it's members -
Length(aryInteger) * SizeOf(Integer) }
if noWrite(aryInteger[Zero], DataSize*SizeOf(Integer)) then Exit;
// use the First menber of the array aryInteger[Zero] as the Source buffer
CloseHandle(hFile);
MessageBox(hForm1, PChar('Data File has been Created at'#10+OutFile),
'SUCCESS, Data File Creation', MB_ICONINFORMATION);
end;
// LoadVarData will read the non-fixed size variables from the file
procedure LoadVarData(const InFile: String);
var
hFile,BytesRead: Cardinal;
ID: Array[Zero..5] of Char;
DataSize: Integer;
Str1: String;
pText: PChar;
aryInteger: Array of Integer;
function noRead(var Source; Size: Cardinal): Bool;
begin
// noRead will return True if the file read is NOT successful
if ReadFile(hFile,Source,Size,BytesRead,nil) and (BytesRead = Size) then
Result := False
else
begin
CloseHandle(hFile); // close handle if read error
SysErrorMsg(ReadErrText, ReadErrTitle);
Result := True;
end;
end;
begin
// InFile is the text in the hVarEdit Edit box
if Length(InFile) < 6 then
begin
MessageBox(hForm1, 'ERROR - Data File Name must be at least 6 Charaters',
'Invalid Data File Name', MB_ICONERROR);
Exit;
end;
// open the file for reading
hFile := CreateFile(PChar(InFile),GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+InFile, CreateErrTitle);
Exit;
end;
// if noRead fails (with True) then Exit
if noRead(ID, SizeOf(ID)) then Exit;
// for safty get the File Identification number, and test it
if ID <> FileDataID then
begin
CloseHandle(hFile);
MessageBox(hForm1, PChar('ERROR - This File is NOT a Valid Var Data File'#10+InFile),
'ERROR, NOT a Valid Data File', MB_ICONERROR);
Exit;
end;
// read the length of the String text data
if noRead(DataSize, SizeOf(DataSize)) then Exit;
SetLength(Str1, DataSize); // get memory for the string
if noRead(Str1[One], DataSize) then Exit; // read data into string
if noRead(DataSize, SizeOf(DataSize)) then Exit;
// read text length and get memory, the NULL char #0 is included
GetMem(pText, DataSize);
if noRead(pText^, DataSize) then // this also reads the final NULL terminator
begin
FreeMem(pText); // free the memory before Exit
Exit;
end;
if noRead(DataSize, SizeOf(DataSize)) then // read number of integers in array
begin
FreeMem(pText);
Exit;
end;
SetLength(aryInteger, DataSize); // get memory for the array with SetLength( )
if noRead(aryInteger[Zero], DataSize*SizeOf(Integer)) then
begin
FreeMem(pText);
Exit;
end;
CloseHandle(hFile);
MessageBox(hForm1, PChar(Str1+#10+pText+#10+Int2Str(aryInteger[Zero])),
'SUCCESS, Data File Read', MB_ICONINFORMATION);
FreeMem(pText);
end;
{this SaveStringRecs procedure will show how to save records with strings to file
this will create a file header with the position and size of each string record}
procedure SaveStringRecs;
var
hFile: Cardinal;
i, Len, headerPos: Integer;
aryStrR: Array of TStrRec; { TStrRec records are the Data stored in this file.
I use a file header with one THeader record for every TStrRec record.
The THeader record has the position and size of the TStrRec record in file,
this allows you to access the data for just ONE TStrRec record at a time.}
aryHeader: Array of THeader;
BytesWrite: Cardinal;
BadFile: Boolean;
function tryWrite(var Source; Size: Cardinal): Bool;
begin
// tryWrite will return True if the write is NOT successful
if WriteFile(hFile,Source,Size,BytesWrite,nil) and (BytesWrite = Size) then
Result := False
else
begin
SysErrorMsg(WriteErrText, WriteErrTitle);
BadFile := True;
Result := True;
end;
end;
begin
SetLength(aryStrR, 5);
// there are 5 TStrRec in this aryStrR array
for i := 0 to High(aryStrR) do
with aryStrR[i] do
begin
// fills the array elements with data
Width := (i+1)*20;
Height := (i+1)*10;
{ the TextLines below are the main "Data" stored in this file. These text
strings would be long strings from a Memo Edit}
case i of
0: TextLines := 'The text of FUNNY'#13#10'that is here'#13#10'for Text Lines.';
1: TextLines := 'More text to show, as SAD subject you'#13#10+
'can see in the edit box';
2: TextLines := 'This is the FOOD text'#13#10'with 4 lines'#13#10'of info'+
#13#10'here to view.';
3: TextLines := 'Words for the WATER'#13#10'are here in this'#13#10+
'Text Block of words.';
4: TextLines := 'The subject of MONEY has'#13#10'this text information'+
#13#10'as lines of words.';
end;
end;
hFile := CreateFile(StringFile,GENERIC_WRITE,FILE_SHARE_READ,nil,
CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+StringFile, CreateErrTitle);
Exit;
end;
{In this file I will have a file header that is used to store data segment
position and size in a THeader. There will be 5 THeader records in the the
file header, one for each TStrRec in this file}
SetLength(aryHeader, Length(aryStrR)); // make aryHeader the same length as aryStrR
headerPos := (Length(aryHeader)* SizeOf(THeader))+8;
{all file data position is math, the headerPos is used to store the
location of for each TStrRec, to get the position of the first TStrRec,
you multiply the number of THeader in aryHeader, by the byte size of a
THeader. . . You must add eight to it because you have 2 file header integers
- FileStrID - and - Len - written to file.}
for i := 0 to High(aryHeader) do
with aryHeader[i] do
begin
// in order to access one TStrRec record, you need it's file position
Position := headerPos;
// You must do the math to calculate the file bytes occupied by this TStrRec
Size := 12+Length(aryStrR[i].TextLines);
{ the Size will be the length of the string + 12, , 8 bytes for the
Width and Height in the record, and 4 bytes for the - Len - integer
added to file later, to record the length of the string.}
case i of
0: ListText := 'Funny stuff';
1: ListText := 'Sad things';
2: ListText := 'The Food is here';
3: ListText := 'You need Water';
4: ListText := 'Show me the Money';
// ListText will be shown in a List Box when the file header is read
end;
Inc(headerPos, Size); // add the record size to file position
end;
BadFile := False;
Len := Length(aryStrR);
{ first I write a File type ID number to the file.
For your data files you should have some kind of Identifier
as the first data block in the file, so you can try and detect if this file
has the data bytes that you know how to read}
if not tryWrite(FileStrID, SizeOf(FileStrID)) and
not tryWrite(Len, SizeOf(Len)) and { write number of TStrRec in array
put the aryHeader into the file as a file header}
not tryWrite(aryHeader[0], Length(aryHeader)*SizeOf(THeader)) then
for i := Zero to High(aryStrR) do // for loop through all strings
begin
if tryWrite(aryStrR[i], 8) then Break;
{IMPORTANT - I do NOT write the entire TStrRec to file, since it has a string
in it. I only write the Fixed-Size variables, Width and Height, by setting
the file write Size to 8}
Len := Length(aryStrR[i].TextLines);
// IMPORTANT you must always write the length of the string data to file
if tryWrite(Len, SizeOf(Len)) then Break;
if tryWrite(aryStrR[i].TextLines[One], Len) then Break;
{ without the file segment size (number of bytes),
you will not be able to read out this string}
end;
CloseHandle(hFile);
if BadFile then
begin
DeleteFile(StringFile);
MessageBox(hForm1, 'ERROR - String Record File Could not be fully Written',
'ERROR, NO data File', MB_ICONERROR);
end else
MessageBox(hForm1, PChar('String Record File has been Created at'#10+StringFile),
'SUCCESS, Data File Creation', MB_ICONINFORMATION);
end;
{the LoadListBox procedure will not read the entire file, it will only read the
file header, which is 5 THeader records, it will read the 5 records and place
the ListText string in a List Box}
procedure LoadListBox;
var
hFile, Len: Cardinal;
i: Integer;
aryHeader: Array of THeader;
BytesRead, ID: Cardinal;
function tryRead(var Dest; Size: Cardinal): Bool;
begin
// returns True if Successful
if ReadFile(hFile,Dest, Size, BytesRead,nil) and (Size = BytesRead) then
Result := True
else
begin
CloseHandle(hFile);
SysErrorMsg(ReadErrText, ReadErrTitle);
Result := False;
end;
end;
begin
hFile := CreateFile(StringFile,GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+StringFile, CreateErrTitle);
Exit;
end;
if tryRead(ID, SizeOf(ID)) then
begin
// read and test fot the File ID number
if ID <> FileStrID then
begin
CloseHandle(hFile);
MessageBox(hForm1, PChar('ERROR - This File is NOT a Valid String Data File'#10+
StringFile), 'ERROR, NOT a Valid Data File', MB_ICONERROR);
Exit;
end else
if tryRead(Len, SizeOf(Len)) then // read the number of records in the file
begin
if Len > 24 then
begin
// the value of 24 is not anything, you should use your own safety value here
CloseHandle(hFile);
MessageBox(hForm1, PChar('ERROR - Array length is more than limit '#10+
StringFile), 'ERROR, Bad File Amount', MB_ICONERROR);
Exit;
end;
SetLength(aryHeader, Len);// get memory for your array with SetLength( )
// now read all of the file header records into the array
if tryRead(aryHeader[0], Len*SizeOf(THeader)) then
begin
SendMessage(hListBox, LB_RESETCONTENT, Zero, Zero);
//Clear and enable list box
EnableWindow(hListBox, True);
for i := 0 to High(aryHeader) do
SendMessage(hListBox,LB_ADDSTRING, Zero,
Integer(@aryHeader[i].ListText[One]));
// FOR loop to send all ListText strings to hListBox
end;
end;
end;
CloseHandle(hFile);
end;
{the Load1StringRec procedure will use the file created above, and read just
ONE THeader record and ONE TStrRec out of the file.}
procedure Load1StringRec;
var
hFile: Cardinal;
Len, CurSel: Integer;
Header1: THeader;
StrRec1: TStrRec;
BytesRead, ID: Cardinal;
BadFile: Boolean;
MemoStr: String;
function tryRead(var Dest; Size: Cardinal): Bool;
begin
// returns true is Un-successful
if ReadFile(hFile,Dest, Size, BytesRead,nil) and (Size = BytesRead) then
Result := False
else
begin
CloseHandle(hFile);
BadFile := True;
Result := True;
SysErrorMsg(ReadErrText, ReadErrTitle);
end;
end;
begin
if not IsWindowEnabled(hListBox) then
begin
MessageBox(hForm1, 'Error - You must Load a String Record File First',
'ERROR, No File Loaded', MB_ICONERROR);
Exit;
end;
CurSel := SendMessage(hListBox, LB_GETCURSEL, Zero, Zero);
{ IMPORTANT - use the lixt box select index as the index of the THeader record
and the index of the TStrRec to read from the file}
if CurSel = LB_ERR then
begin
MessageBox(hForm1, 'Error - There is no List Box Selection',
'ERROR, No List box Select', MB_ICONERROR);
SendMessage(hListBox, LB_SETCURSEL, Zero, Zero);
Exit;
end;
// open the file for reading
hFile := CreateFile(StringFile,GENERIC_READ,FILE_SHARE_READ,nil,
OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN,Zero);
if hFile = INVALID_HANDLE_VALUE then
begin
SysErrorMsg(CreateErrText+#10+StringFile, CreateErrTitle);
Exit;
end;
BadFile := False;
if not tryRead(ID, SizeOf(ID)) then
begin
// read and test for the File ID number
if ID <> FileStrID then
begin
BadFile := True;
MessageBox(hForm1, PChar('ERROR - File is NOT a Valid String Record Data File'+
#10+StringFile), 'ERROR, NOT a Valid Data File', MB_ICONERROR);
end else
if not tryRead(Len, SizeOf(Len)) then // read the number of strings in the file
begin
{I have included a test for the size of the Len variable, which should contain
the numbar of string records in this file. If it is larger than 24 then I error
out of this code. You should have some kind of "Safety" check for array lengths
when you are building code and testing it. If in your code you incorrctly
place the file position you may read an incorrect amount for the array length.
It may read a value of 4 gigs and try and set the array length to that.
Although this string file is very simple, I still place a test. After you
get this working and test it, you can remove your safty test.}
if Len > 24 then
begin
// the value of 24 is not anything, you should use your own safety value here
CloseHandle(hFile);
MessageBox(hForm1, PChar('ERROR - Array length is more than limit '+
#10+StringFile),'ERROR, Bad File Amount', MB_ICONERROR);
Exit;
end;
if CurSel > Len then // another safety test
begin
CloseHandle(hFile);
MessageBox(hForm1, 'Error, The List Box Selection is Out of Range of the file',
'ERROR, Selection Incorrect', MB_ICONERROR);
Exit;
end;
{use the Index in CurSel to get the file position of the THeader record to
read. You mutiply the index by the size of the THeader. Use SetFilePointer
to change the file position.}
if CurSel > 0 then
SetFilePointer(hFile,CurSel*SizeOf(THeader),nil, FILE_CURRENT);
// Read only One THeader record from this file into Header1
if not tryRead(Header1, SizeOf(Header1)) then
begin
{The file position of the TStrRec record for this Index is in the
Header1.Position, so move the file to the new position}
SetFilePointer(hFile,Header1.Position,nil, FILE_BEGIN); // from beginning
tryRead(StrRec1, 8); // only read the 2 fixed-Size variables with 8 read size
tryRead(Len, SizeOf(Len)); // you must use a length number to read a string
if Len > 256 then // safety test
begin
// the value of 256 is not anything, you should use your own safety value here
CloseHandle(hFile);
MessageBox(hForm1, PChar('ERROR - Array length is more than limit '+
#10+StringFile),'ERROR, Bad File Amount', MB_ICONERROR);
Exit;
end;
SetLength(StrRec1.TextLines, Len);
// get string memory with SetLength , and read the string
tryRead(StrRec1.TextLines[1], Len);
// next add the width and height to MemoStr string, and set text in hEdit2
MemoStr := 'Width = '+Int2Str(StrRec1.Width)+' Height = '+
Int2Str(StrRec1.Height)+#13#10#13#10+StrRec1.TextLines;
SetWindowText(hEdit2, PChar(MemoStr));
end;
end else
BadFile := True;
end;
CloseHandle(hFile);
if BadFile then
begin
MessageBox(hForm1, PChar('ERROR - String File Could not be fully Read '+
#10+StringFile), 'ERROR, NO READ data File', MB_ICONERROR);
end;
end;
end. |
| You will need to keep working with the file read and write methods, using different variables and data blocks, and different data arrangements, and different file access (sequential, ramdom), and just experiment, until you get to understand what you need to do to make and read files that can store the information you need. |
Next Page
The next Lesson shows you more ways to create top-level Pop-Up windows and ways to use them.
16. More Form Windows
H O M E
