If you would show your code has you did it it would be
easier to point the mistake!!!
Anyway this posting includes a working test-form
source code that writes and reads a dynamic size array.
A typical error is the use of the BlockRead/BlockWrite
second parameter, wich isn't a pointer but an untyped
variable passed by reference.
This routines will get the address form any variable
that refers the start of the buffer, like in this code
shows:
***** Start of segment from the writing routine bellow ******
AssignFile(f, i_fileName);
Rewrite(f, 1); // Set to 1 byte record size,
// so BlockWrite works OK!
BlockWrite(f, i_count, sizeOf(i_count));
BlockWrite(f, i_pArray^[1], i_count * sizeOf(i_pArray^[1]));
// We don't pass a pointer here but a reference to the
// start of the array since the BlockWrite procedure
// expects is an untyped variable passed by reference
CloseFile(f);
***** End of segment from the writing routine bellow ******
Follows the test form code ("uFrmDynArrayWrite.PAS") and
layout ("uFrmDynArrayWrite.DFM") as text.
*******************************************************
*******************************************************
Form Code Start
*******************************************************
unit uFrmDynArrayWrite;
// Made for Delphi 3 (can try it with 2)
// but the meat of the code (store and read array) works since Turbo Pascal
// if you shrink the array type to fit in 64k and fix the comments to /* */
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Spin, Buttons;
type
TfrmDynArrayWrite = class(TForm)
pnlCommands: TPanel;
memoResults: TMemo;
btnClose: TBitBtn;
btnWrite: TBitBtn;
btnRead: TBitBtn;
lblFileName: TLabel;
dlgFileOpen: TOpenDialog;
dlgFileSave: TSaveDialog;
spnAlemCount: TSpinEdit;
procedure btnCloseClick(Sender: TObject);
procedure btnWriteClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnReadClick(Sender: TObject);
private
{ Private declarations }
procedure wrt(i_str : string);
public
{ Public declarations }
end;
var
frmDynArrayWrite: TfrmDynArrayWrite;
implementation
{$R *.DFM}
const
_defTestCount = 5;
_defFileName = 'ArrayTest';
//============================================================
//============================================================
//============================================================
//===== BEGIN OF THE MEAT OF THIS CODE =====
type
TMyRecord = record
firstString : string[52];
secondString : string[80];
thirdString : string[255];
firstArray : Array[1..10] of string[15];
secondArray : Array[1..10] of string[40];
thirdArray : Array[1..10] of SmallInt;
end;
type
TDynArray = Array[1..10000] of TMyRecord;
PDynArray = ^TDynArray;
// Allocate array with <i_count> elements
procedure arrayAlloc(var io_pArray : PDynArray; i_count : integer);
begin
GetMem(io_pArray, i_count * sizeOf(io_pArray^[1]));
end;
// Free array with <i_count> elements
procedure arrayFree(var io_pArray : PDynArray; i_count : integer);
begin
FreeMem(io_pArray, i_count * sizeOf(io_pArray^[1]));
io_pArray := Nil;
end;
// Put array pointed by <io_pArray>, with <i_count> elements
// in file named <i_fileName>
procedure arrayPut( i_pArray : PDynArray; i_count : integer;
i_fileName : string
);
var
f : file;
begin // arrayPut
AssignFile(f, i_fileName);
Rewrite(f, 1); // Set to 1 byte record size,
// so BlockWrite works OK!
BlockWrite(f, i_count, sizeOf(i_count));
BlockWrite(f, i_pArray^[1], i_count * sizeOf(i_pArray^[1]));
// We don't pass a pointer here but a reference to the
// start of the array since the BlockWrite procedure
// expects is a untyped variable passed by reference
CloseFile(f);
end; // arrayPut
// Allocates <o_pArray> and reads it from file named
// <i_fileName> returning elemnt count in <o_count>
procedure arrayGet( var o_pArray : PDynArray;
var o_count : integer;
i_fileName : string
);
var
f : file;
begin // arrayGet
AssignFile(f, i_fileName);
Reset(f, 1); // Set to 1 byte record size,
// so BlockRead works ok
BlockRead(f, o_count, sizeOf(o_count));
arrayAlloc(o_pArray, o_count);
BlockRead(f, o_pArray^[1], o_count * sizeOf(o_pArray^[1]));
// We don't pass a pointer here but a reference to the
// start of the array since the BlockRead procedure
// expects is a untyped variable passed by reference
CloseFile(f);
end; // arrayGet
//===== END OF THE MEAT OF THIS CODE =====
//============================================================
//============================================================
//============================================================
// Array Initialization for testing
procedure arrayInit(io_pArray : PDynArray; i_count : integer);
var
i, j : integer;
function strRpt(i_howMany : integer; i_strToRepeat : string) : string;
var k : integer;
begin
Result := '';
for k := 1 to i_howMany do
Result := Result + i_strToRepeat;
end; // strRpt
begin // arrayInit
for i := 1 to i_count do
with io_pArray^[i] do
begin
firstString := strRpt(i, '1st');
secondString := strRpt(i, '2nd');
for j := 1 to 10 do
begin
firstArray [j] := '1a->' + intToStr(i) + 'x' + intToStr(j);
secondArray[j] := '2a->' + intToStr(i) + 'x' + intToStr(j);
thirdArray [j] := i*100 + j;
end; // for j
end; // with / for i
end; // arrayInit
// show array in a memo for testing
procedure arrayShow( var i_pArray : PDynArray; i_count : integer;
i_memo : tMemo
);
const
_sep = '; ';
// Add a line with the string <i_line> to the
// memo <i_memo> passed to the master procedure
procedure wr(i_line : string);
begin // wr
i_memo.Lines.Add(i_line);
end; // wr
// Returns string in <i_str> after
// removing last separator and appending ")"
function endedLine(i_str : string) : string;
var
l : integer;
begin // endedLine
l := length(i_str) - 1;
Result := copy(i_str, 1, l);
Result[l] := ')';
end; // endedLine
var
i, j : integer;
line : string;
begin
wr('Array of ' + intToStr(i_count) + ' elements');
for i := 1 to i_count do
begin
wr(intToStr(i) + ' = (');
with i_pArray^[i] do
begin
wr(' firstString = ' + firstString);
wr(' secondString = ' + secondString);
line := ' firstArray = (';
for j := 1 to 10 do
line := line + firstArray[j] + _sep;
wr(endedLine(line));
line := ' secondArray = (';
for j := 1 to 10 do
line := line + secondArray[j] + _sep;
wr(endedLine(line));
line := ' thirdArray = (';
for j := 1 to 10 do
line := line + intToStr(thirdArray[j]) + _sep;
wr(endedLine(line));
end; // with
wr(')');
end; // for i
end;
// Initialize and write test array with <i_count> elements
// to file named <i_fileName>
procedure arrayInitAndWrite(i_count : integer; i_fileName : string);
var
pArray : PDynArray;
begin
pArray := Nil;
arrayAlloc(pArray, i_count);
try
arrayInit(pArray, i_count);
arrayPut(pArray, i_count, i_fileName);
finally
arrayFree(pArray, i_count);
end; // try / finally
end;
// Read test array from file named <i_fileName>
// returning element count in o_elemCount and
// showing array in memo referenced by <i_memo>
procedure arrayReadAndShow( i_fileName : string;
var o_elemCount : integer;
i_memo : tMemo
);
var
pArray : PDynArray;
begin
pArray := Nil;
arrayGet(pArray, o_elemCount, i_fileName);
try
arrayShow(pArray, o_elemCount, i_memo);
finally
arrayFree(pArray, o_elemCount);
end; // try / finally
end;
// Add a line with the string <i_str> to the form's memo
procedure TfrmDynArrayWrite.wrt(i_str : string);
begin
memoResults.Lines.Add(i_str);
end;
// Run's write test
procedure TfrmDynArrayWrite.btnWriteClick(Sender: TObject);
var
fn : string;
begin
dlgFileSave.FileName := lblFileName.Caption;
if dlgFileSave.Execute then
begin
fn := dlgFileSave.FileName;
lblFileName.Caption := fn;
arrayInitAndWrite(spnAlemCount.Value, fn);
wrt(stringOfChar('=', 40));
wrt('Wrote array with ' + intToStr(spnAlemCount.Value) + ' elements
to ' + fn);
wrt(stringOfChar('=', 40));
end; // if
end;
// Run's read test
procedure TfrmDynArrayWrite.btnReadClick(Sender: TObject);
var
fn : string;
elemCount : integer;
begin
dlgFileOpen.FileName := lblFileName.Caption;
if dlgFileOpen.Execute then
begin
fn := dlgFileOpen.FileName;
lblFileName.Caption := fn;
wrt(stringOfChar('=', 40));
wrt('Reading from ' + fn);
arrayReadAndShow(fn, elemCount, memoResults);
wrt(stringOfChar('=', 40));
spnAlemCount.Value := elemCount;
end; // if
end;
// Test initialization
procedure TfrmDynArrayWrite.FormCreate(Sender: TObject);
begin
lblFileName.Caption := extractFilePath(Application.ExeName) +
_DefFileName;
spnAlemCount.Value := _defTestCount;
end;
// Close the test
procedure TfrmDynArrayWrite.btnCloseClick(Sender: TObject);
begin
Close;
end;
end.
*******************************************************
Form Code End
*******************************************************
*******************************************************
*******************************************************
*******************************************************
Form Layout Start
...
read more »
