Erreur de lecture de fichier non typé

Version imprimable

Bonjour,

j'ai le code suivant :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    var
        // File
        lrFile : File ;
        // Aborted
        lbAborted : Boolean ;
        // Buffer
        laBuffer : TMemory ;
        // Count of read
        liCountRead : Integer ;
    begin
        Filemode := fmOpenRead ;
 
        GetMem(laBuffer, piUserBufferSize) ;
 
        AssignFile(lrFile, asFileName) ;
        Reset(lrFile, 1) ;
 
        lbAborted := IsAborted ;
 
        liCountRead := piUserBufferSize ;
 
        while (IOResult = 0) and (liCountRead = piUserBufferSize)
            and not lbAborted do
        begin
            BlockRead(lrFile, laBuffer, piUserBufferSize, liCountRead) ;
 
            aoDataSocket.SendBuffer(laBuffer, liCountRead) ;
 
            lbAborted := IsAborted ;
 
            if piWaitingTransfertTime > 0
            then begin
                Sleep(piWaitingTransfertTime) ;
            end ;
        end ;
 
        FreeMem(laBuffer) ;
 
        if lbAborted
        then begin
            Result := trAborted ;
        end
        else if IOResult = 0
        then begin
            Result := trNoError ;
        end
        else begin
            Error(GetIoResultString(IOResult) + ' ' + asFileName) ;
            Result := trError ;
        end ;
 
        CloseFile(lrFile) ;
    end ;

Mon problème, c'est que BlockRead ne lit rien. J'ai un runtime error 998.

Le problème vient de laBuffer qui est un pointer. Si je met laBuffer^ c'est bon, mais j'ai un doute.

Quelqu'un peut m'éclairer ?

Merci

BlockRead écrit les données lues dans la variable que tu passes en deuxième paramètre. Si tu utilises laBuffer^ il écrit dans le TMemory pointé par laBuffer. Si tu utilises laBuffer il écrit dans le pointeur et comme le pointeur ne fait que 4 ou 8 octets il écrit même au delà et vraisemblablement ou il ne devrait pas d'où la 'runtime error'.

Plûtot que GetMem FreeMem tu peux aussi utiliser un tableau dynamique :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 procedure PrintText(Name: String); const BufferSize = 256; var Buffer: array of byte; DataFile: file; Finished : Boolean; Count, I : Word; begin SetLength(Buffer, BufferSize); AssignFile(DataFile,Name); Reset(DataFile, 1); Count:=0; Finished:=false; while not Finished do begin BlockRead(DataFile, Buffer[0], BufferSize, Count); for I:=0 to Count - 1 do Write(Chr(Buffer[I])); if Count < BufferSize then Finished:=true; end; CloseFile(DataFile); end;

05/02/2010, 08h26
bubulemaster

Bonjour,

merci de la précision.

Si je veux pointer sur le tableau je fais @Buffer[0] et non @Buffer si j'ai bien compris.

Citation:

Si je veux pointer sur le tableau je fais @Buffer[0] et non @Buffer si j'ai bien compris.

@Buffer -> Adresse du tableau
@Buffer[X] -> Adresse de l'élément X du tableau. Si X est le 1er élément du tableau alors (@Buffer[X] = @Buffer) ( !!! sauf pour les tableaux dynamiques !!!).

Peut être que quelques exemples pourront t'éclairer :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
program Test;
 
{$mode objfpc}{$H+}
 
uses
  SysUtils;
 
{ transforme un tableau de byte en chaîne }
function ToStr(Tab : array of Byte): String;
var
  I : Integer;
begin
  Result:='';
 
  for I:=Low(Tab) to High(Tab) - 1 do
    Result:=Result+Chr(Tab[I]);
 
  Result:=Result+Chr(Tab[High(Tab)]);
 
  { remplace les caractères spéciaux par '_' }
  for I:=1 to Length(Result) do
    if Result[I] < ' ' then Result[I]:='_';
end;
 
var
  DataFile : file;
  B : Byte;
  TabByte : array [1..20] of Byte;
  DynTabByte : array of Byte;
  Count : Word;
begin
  Assign(DataFile, 'test.pas');
  Reset(DataFile, 1);
 
  // Lecture de 1 Byte dans B
  BlockRead(DataFile, B, 1, Count);
  WriteLn(Chr(B), ' : ', Count);
 
  // Remplissage de tout TabByte
  BlockRead(DataFile, TabByte, Length(TabByte), Count);
  WriteLn(ToStr(TabByte), ' : ', Count);
 
  SetLength(DynTabByte, 10);
 
  // Remplissage de  DynTabByte devrait être
  // BlockRead(DataFile, DynTabByte, Length(DynTabByte), Count);
  // Mais ==> Runtime error 216
  //
  // En fait pour les tableaux dynamiques il faut écrire
  BlockRead(DataFile, DynTabByte[0], Length(DynTabByte), Count);
  WriteLn(ToStr(DynTabByte), ' : ', Count);
 
  // Cette écriture marche aussi pour les tableaux statiques
  BlockRead(DataFile, TabByte[1], Length(TabByte), Count);
  WriteLn(ToStr(TabByte), ' : ', Count);
 
  // Comparaison des adresses
  WriteLn;
  WriteLn('TabByte    : ', Cardinal(@TabByte):10, ' : ', Cardinal(@TabByte[1]):10);
  WriteLn('DynTabByte : ', Cardinal(@DynTabByte):10, ' : ', Cardinal(@DynTabByte[0]):10);
 
  Close(DataFile);
end.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
 
interface
 
{...}
 
type
  TSendFileEvent    = procedure (aFileName: string; aFileSize, aFileSend: int64; var vAbort: boolean) of object;
 
type
  TFormX = class(TForm) 
    { ... } 
  private
    fSleep     : LongWord;
    fIsAborted : boolean;
  protected
    procedure DoSendFile(aFileName: string; aFileSize, aFileSend: int64; var vAbort: boolean);
  public
    function SendFile(aFileName: string; aBufferSize: integer; aSFCallBack: TSendFileEvent): integer;
  end;
 
var
  FormX : TFormX;
 
implementation
 
{ ... }
 
procedure TFormX.ButtonAbortClick(Sender: TObject);
begin
  fIsAborted := true;
end;
 
procedure TFormX.DoSendFile(aFileName: string; aFileSize, aFileSend; int64; var vAbort: boolean);
var
  Sl : LongWord;
begin
  labelFileName.Caption := aFileName;
  FileProgress.Position := trunc(100 * (aFileSend/aFileSize));
 
  if fSleep > 0 then
  begin
    Sl := GetTickCount + fSleep;
    while GetTickCount < Sl do
    begin
      vAbort := fIsAborted;
      Application.ProcessMessages;
    end;
  end;
end;
 
const
  SF_NOERROR           = 0;
  SF_FILENOTFOUND      = 1;
  SF_BUFFERSIZEINVALID = 2;
  SF_FILESTREAMERROR   = 3;
  SF_BUFFERALLOCERROR  = 4;
  SF_FILEREADSENDERROR = 5;
  SF_SENDABORTED       = 6;
  SF_UNKNOWNERROR = 7;
 
function TFormX.SendFile(aFileName: string; aBufferSize: integer; aSFCallBack: TSendFileEvent): integer;
var
  lbAborted   : Boolean;
  lpBuffer    : ^byte;
  liCountRead : Integer;
  liFileSize,
  liFileRead,
  liFileSend  : int64;
begin
  result := SF_FILENOTFOUND;
 
  if not FileExists(aFileName) then
    exit;
 
  result := SF_BUFFERSIZEINVALID;
  if aBufferSize <= 0 then
    exit;
 
  result := SF_FILESTREAMERROR;
  with TFileStream.Create(aFileName, fmOpenRead) do
  try
    liFileSize := Size;
    liFileRead := 0;
    liFileSend := 0;
 
    result := SF_BUFFERALLOCERROR;
    GetMem(lpBuffer, aBufferSize);
    try
      lbAborted := false;
      result := SF_UNKNOWNERROR;
      repeat
        liCountRead := Read(lpBuffer^, aBufferSize);
 
        liFileSend := liFileSend + aoDataSocket.SendBuffer(lpBuffer^, liCountRead);
 
        liFileRead := liFileRead + liCountRead;
 
        if assigned(aSFCallBack) then
          aSFCallBack(aFileName, liFileSize, liFileSend, lbAborted);
 
      until (liCountRead <> aBufferSize) or lbAborted;
 
      if (liFileSize = liFileRead) and (liFileSize = liFileSend) then
        result := SF_NOERROR
      else
      begin
        if lbAborted then
          result := SF_SENDABORTED
        else
        if liFileSize <> liFileSend then
          result := SF_FILEREADSENDERROR;
      end;
    finally
      FreeMem(lpBuffer, aBufferSize);
    end;
  finally
    Free;
  end;
end;
 
{ ... }
 
end.

05/02/2010, 14h14
bubulemaster

Merci à vous pour les exemples. J'ai tout compris