Problème de conversion de code VB en delphi

Version imprimable

salut tout le monde ,
Qui peu m'aidez a convertir ces ligne de code Vb en delphi ?
vraiment je me suis coincé !

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
 
Dim FES As String * 16
Dim FES_TIME As String * 4
Dim Datum As Date
 
Dim t As Integer
Dim szHelp As String
Dim szHelp2 As String
Dim f As Integer
Dim v As Variant
Dim l As Long
f = FreeFile
    Open App.Path + "\Jugl.db" For Binary Access Read As #f
        Do While Not EOF(f)
            Get #f, , FES
            If EOF(f) Then Exit Do
            Get #f, , FES_TIME
 
            szHelp = ""
            For t = 1 To 4
                szHelp = szHelp + Right("00" + Hex(Asc(Mid(FES_TIME, t, 1))), 2)
            Next
            l = "&H" & szHelp
            Datum = DateAdd("s", l, CDate("01.01.1970"))
            szHelp = ""
            Dim c As Integer
            For t = 1 To 16
                c = Asc(Mid(FES, t, 1))
                szHelp = szHelp + Right("00" + Hex(c), 2)
            Next
 List1.AddItem Format(Datum, "hh:mm:ss dd.mm.yyyy") + " -> " + szHelp
 
        Loop
 
    Close #f
et 
Private Sub Command3_Click()
Dim szFilename As String
Dim t As Integer
Dim szHelp As String
Dim f As Integer
Dim Data() As String
 
    szFilename = App.Path + "\v_fes.txt"
    List1.Clear
 
    szHelp = Space(FileLen(szFilename))
 
    f = FreeFile
    Open szFilename For Binary Access Read As #f
        Get #f, , szHelp
    Close #f
    Data = Split(szHelp, vbCrLf)
 
    For t = 0 To UBound(Data)
        If Trim(Data(t)) <> "" Then
            List1.AddItem Trim(Data(t))
        End If
    Next t

et Merci d'avance

salut

il me manque quelque fonction mais voila en gros ce que cela donnera

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
 
 
function Right(st : String;i : integer) : String;
begin
  Result := Copy(st,length(st)-i,i);
end;
 
var
 FES : String[16];
 FES_TIME : String[4];
 Datum : TDateTime;
 t : Integer;
 c : Integer;
 szHelp : String;
 szHelp2 : String;
 v : Variant;
 l : Longint;
 szFilename : String;
 Stream : TFileStream;
begin
  szFilename := ExtractFilepath(Application.ExeName) + '\Jugl.db';
  Stream := TFileStream.Create(szFilename,fmOpenRead);
  While Not(Stream.Size < Stream.Position) do
  begin
    Stream.Read(FES,length(FES));
    If (Stream.Size < Stream.Position) Then
      Exit;
    Stream.Read(FES_TIME,length(FES_TIME));
    szHelp := '';
    For t := 1 To 4 do
      szHelp := szHelp + Right('00' + Hex(ord(Copy(FES_TIME,t,1))),2)
    l := '$'+ szHelp
    Datum := DateAdd('s',l,EncodeDate(1970,01,01))
    szHelp := '';
    For t = 1 To 16 do
    begin
      c := ord(copy(FES, t, 1))
      szHelp := szHelp + Right('00'+Hex(c), 2)
    end;
    List1.AddItem(FormatDateTime('hh:mm:ss dd.mm.yyyy',Datum) + ' -> ' + szHelp
  end;
  Stream.Free;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
Var
  szFilename : String;
  t : Integer;
  szHelp : String;
  f : Integer;
  Data  : array of String;
begin
  szFilename := ExtractFilepath(Application.ExeName) + '\v_fes.txt';
  List1.Clear
 
//  szHelp := Space(FileLen(szFilename))
  Stream := TFileStream.Create(szFilename,fmOpenRead);
  While Not(Stream.Size < Stream.Position) do
  begin
    Stream.Read(szHelp,Stream.Size);
  end;
  Stream.Free
 
  Data := Split(szHelp, vbCrLf)
 
  For t := 0 To high(Data) do
  begin
    If Trim(Data[t]) <> '' Then
     List1.AddItem(Trim(Data[t]))
  end;
end;

@+ Phil

04/04/2007, 07h48
neilbgr

En faisant un uses de StrUtils, la fonction RightStr et beaucoup d'autres inspirées de VB sont disponibles.

Code:

function RightStr(const AText: string; const ACount: Integer): string;

salut ,
erci pour cette aide ,
j'ai pas compris une chose les lignes qui sont en rouge , en plus sa bug au copilation !!

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 TForm1.Button1Click(Sender: TObject);
Var
  szFilename : String;
  t : Integer;
  szHelp : String;
  f : Integer;
  Data  : array of String;
  Stream : TFileStream;
begin
  szFilename := ExtractFilepath(Application.ExeName) + '\v_fes.txt';
  List1.Clear ;

//  szHelp := Space(FileLen(szFilename))
  Stream := TFileStream.Create(szFilename,fmOpenRead);
  While Not(Stream.Size < Stream.Position) do
  begin
    Stream.Read(szHelp,Stream.Size);
  end;
  Stream.Free ;
 
  Data := Split(szHelp, vbCrLf) ;
 
  For t := 0 To high(Data) do
  begin
    If Trim(Data[t]) <> '' Then
     List1.AddItem(Trim(Data[t]))
  end;
end;

05/04/2007, 02h26
Fabrice ROUXEL 1

Cette ligne est en commentaire:

Code:

// szHelp := Space(FileLen(szFilename))

Essayes de la remplacer par celle là:

Code:

FillChar(szHelp, SizeOf(szFilename), Ord(' '));

Je te laisse chercher l'équivalent de split en Delphi.

salut ,
merci beaucoup pour cette aide , mais reste un bug dans ces derniers lignes.

Code:

1
2
3
4
5
6
7
8
Data := Split(szHelp, vbCrLf) ;
 
  For t := 0 To high(Data) do
  begin
    If Trim(Data[t]) <> '' Then
     List1.AddItem(Trim(Data[t]))
  end;
end;

05/04/2007, 15h42
DragonHeart
Si je me trompe pas VbCrLf est une constante VB (saut de ligne + retour chariot) remplace le par #13#10
Code:

1 2 3 4 5 6 7 8 9 Data := Split(szHelp, #13#10) ; For t := 0 To high(Data) do begin If Trim(Data[t]) <> '' Then List1.AddItem(Trim(Data[t])); end; end;
En espérant que ca corrige ...
PS : Quand tu as une erreur indique nous ce que te sort le compilo ca sera bien plus simple pour t'aider ;)

tstststs

En fait split sépare la chaine en prenant crlf comme delimiteur pour affecter chaque morceau coupé dans une liste.

Il faut écrire la fonction split.

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
type TStringsArray = array of string;
function Split(txt: string; delimit: char): TStringsArray;
var
  i: integer;
  deb: integer;
  idx: integer;
begin
  i := 1;
  deb := 1;
  idx := 0;
  txt := Trim(txt);
  SetLength(Result,0);
  while (i < length(txt)) do
  begin
    if (txt[i] = delimit) then
    begin
      SetLength(Result, idx +1);
      Result[idx] := copy(txt, deb, i - deb);
      deb := i;
      inc(idx);
    end;
    inc(i);
  end;
  if i <> deb then
  begin
    SetLength(Result, idx +1);
    Result[idx] := copy(txt, deb, length(txt));
  end;
end;

Code:

1
2
3
4
5
6
7
8
Data := Split(szHelp, '#13') ;
 
  For t := 1To Length(Data) do
  begin
    If (Data[t] <> ' ') Then
     List1.AddItem(Trim(Data[t]))
  end;
end;

et tu modifies la déclaration de Data

Code:

Data: TStringsArray;

05/04/2007, 19h00
anapurna

salut

Citation:

Envoyé par Fabrice ROUXEL 1

Cette ligne est en commentaire:

Code:

// szHelp := Space(FileLen(szFilename))

Essayes de la remplacer par celle là:

Code:

FillChar(szHelp, SizeOf(szFilename), Ord(' '));

Je te laisse chercher l'équivalent de split en Delphi.

heu je ne suis pas sur que ce soit ca la traduction
je vois ca plus dans la definition d'un buffer de taille du fichier et non du nom du fichier mais peut etre me trompai je
c'est pour cette raison que je l'ai mise en commentaire
et remplacé par la lecture direct du fichier entier

Code:

Stream.Read(szHelp,Stream.Size);

@+ Phil
05/04/2007, 19h13
Fabrice ROUXEL 1

Comme je n'ai pas fait de basic depuis 5 ans(A l'époque, j'étais sur un moteur 3d en basic) j'ai jeté un coup d'oeil sur cette fonction.
J'ai trouvé cela:

Citation:

L'exemple suivant utilise la fonction Space pour retourner une chaîne constituée d'un nombre spécifié d'espaces.

Visual Basic Copier le code
Dim TestString As String
' Returns a string with 10 spaces.
TestString = Space(10)
' Inserts 10 spaces between two strings.
TestString = "Hello" & Space(10) & "World"

J'ai bien l'impression que ca initialise le tableau à vide.

A vérifier ! J'avoue que je n'ai pas trop lu son code vb, J'ai rapidement regardé la trad. que tu avais fait.

Bon j'ai regardé plus attentivement ta seconde fonction.
Celle la:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Command3_Click()
Dim szFilename As String
Dim t As Integer
Dim szHelp As String
Dim f As Integer
Dim Data() As String
 
    szFilename = App.Path + "\v_fes.txt"
    List1.Clear
 
    szHelp = Space(FileLen(szFilename))
 
    f = FreeFile
    Open szFilename For Binary Access Read As #f
        Get #f, , szHelp
    Close #f
    Data = Split(szHelp, vbCrLf)
 
    For t = 0 To UBound(Data)
        If Trim(Data(t)) <> "" Then
            List1.AddItem Trim(Data(t))
        End If
    Next t

Remplaces la juste par ça:

Code:

1
2
3
4
5
6
7
procedure TForm1.Button3Click(Sender: TObject);
var list: Strings;
begin
   List := TStringList.Create;
   List.LoadFromFile(ExtractFilepath(Application.ExeName)+'v_fes.txt');
   List.Free;
end;

Evidemment remplace list par la propriete Strings d'un compo oriente list comme une TlistBox, bref le compo liste que tu utilises dans ton interface.

05/04/2007, 19h37
anapurna

salut

+1 pour le stringlist

par contre le space est effectivement la pour remplir la chaine de caractere
le piege et le filelen ;)

sinon moi j'ai fait que du quicbasic c'est pour dire

@+ Phil

salut ,
es que c'est fesable c'est lignes de code

Code:

1
2
3
4
5
6
7
8
9
10
11
For t := 1 To 4 do
      szHelp := szHelp + Right('00' + BinToHex(ord(Copy(FES_TIME,t,1))),2)
    l := '$'+ szHelp
    Datum := DateAdd('s',l,EncodeDate(1970,01,01))
    szHelp := '';
    For t = 1 To 16 do
    begin
      c := ord(copy(FES, t, 1))
      szHelp := szHelp + Right('00'+BinToHex(c), 2);
    end;

salut

Code:

1
2
3
4
5
6
7
8
9
 
  For t := 1 To 4 do
    szHelp := szHelp + Right('00' 
       + Strtoint(IntToHex(ord(Copy(FES_TIME,t,1)))),2)
    l := '$'+ szHelp
    Datum := DateAdd('s',l,EncodeDate(1970,01,01))
    szHelp := '';
    For t = 1 To 16 do
      szHelp := szHelp + Right('00'+Strtoint(IntToHex(ord(copy(FES, t, 1)))), 2);

@+Phil

resalut ,
minforme cette erreur [116] types incompatibles
et voila la source

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
function Right(st : String;i : integer) : String;
begin
  Result := Copy(st,length(st)-i,i);
end;
type TStringsArray = array of string;
function Split(txt: string; delimit: char): TStringsArray;
var
  i: integer;
  deb: integer;
  idx: integer;
begin
  i := 1;
  deb := 1;
  idx := 0;
  txt := Trim(txt);
  SetLength(Result,0);
  while (i < length(txt)) do
  begin
    if (txt[i] = delimit) then
    begin
      SetLength(Result, idx +1);
      Result[idx] := copy(txt, deb, i - deb);
      deb := i;
      inc(idx);
    end;
    inc(i);
  end;
  if i <> deb then
  begin
    SetLength(Result, idx +1);
    Result[idx] := copy(txt, deb, length(txt));
  end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 FES : String[16];
 FES_TIME : String[4];
 Datum : TDateTime;
 t : Integer;
 c : Integer;
 szHelp : String;
 szHelp2 : String;
 v : Variant;
 l : Longint;
 szFilename : String;
 Stream : TFileStream;
begin
  szFilename := ExtractFilepath(Application.ExeName) + '\Jugl.db';
  Stream := TFileStream.Create(szFilename,fmOpenRead);
  While Not(Stream.Size < Stream.Position) do
  begin
    Stream.Read(FES,length(FES));
    If (Stream.Size < Stream.Position) Then
      Exit;
    Stream.Read(FES_TIME,length(FES_TIME));
    szHelp := '';
    For t := 1 To 4 do
    szHelp := szHelp + Right('00'+ StrToInt(IntToHex(ord(Copy(FES_TIME,t,1)))),2);
    l := '$'+ szHelp  ;
    Datum := DateAdd('s',l,EncodeDate(1970,01,01))  ;
    szHelp := '';
    For t = 1 To 16 do
      szHelp := szHelp + Right('00'+Strtoint(IntToHex(ord(copy(FES, t, 1)))), 2);
    end;
    List1.AddItem(FormatDateTime('hh:mm:ss dd.mm.yyyy',Datum) + ' -> ' + szHelp ;
  end;
  Stream.Free;
end;
end;
 
end.

salut

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
 
uses DateUtils;
{$R *.dfm}
 
function Right(st : String;i : integer) : String;
begin
  Result := Copy(st,length(st)-i,i);
end;
type TStringsArray = array of string;
function Split(txt: string; delimit: char): TStringsArray;
var
  i: integer;
  deb: integer;
  idx: integer;
begin
  i := 1;
  deb := 1;
  idx := 0;
  txt := Trim(txt);
  SetLength(Result,0);
  while (i < length(txt)) do
  begin
    if (txt[i] = delimit) then
    begin
      SetLength(Result, idx +1);
      Result[idx] := copy(txt, deb, i - deb);
      deb := i;
      inc(idx);
    end;
    inc(i);
  end;
  if i <> deb then
  begin
    SetLength(Result, idx +1);
    Result[idx] := copy(txt, deb, length(txt));
  end;
end;
 
function DateAdd(interval : string;Quantity: Int64;ADate: TDateTime): TDateTime;
begin
  if ((length(interval) < 2) and (trim(interval) <> ''))  Then
  begin
  Case interval[1] of
  'd': Result := IncDay(ADate,Quantity);
//  'y': Result := IncYear(ADate,Quantity);
  'h': Result := IncHour(ADate,Quantity);
  'n': Result := IncMinute(ADate,Quantity);
  'm': Result := IncMonth(ADate,Quantity);
  'q': Result := IncYear(ADate,Quantity);
  's': Result := IncSecond(ADate,Quantity);
 // 'w': Result := IncSecond(ADate,Quantity);
  end;
  end
  else
   if interval ='ww' Then
     Result := IncWeek(ADate,Quantity)
   else
     if interval ='yyyy' Then;
       Result := IncYear(ADate,Quantity);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  FES : String[16];
  FES_TIME : String[4];
  Datum : TDateTime;
  t : Integer;
  c : Integer;
  szHelp : String;
  szHelp2 : String;
  v : Variant;
  l : Longint;
  szFilename : String;
  Stream : TFileStream;
begin
  szFilename := ExtractFilepath(Application.ExeName) + '\Jugl.db';
  Stream := TFileStream.Create(szFilename,fmOpenRead);
  While Not(Stream.Size < Stream.Position) do
  begin
    Stream.Read(FES,length(FES));
    If (Stream.Size < Stream.Position) Then
      Exit;
    Stream.Read(FES_TIME,length(FES_TIME));
    szHelp := '';
    For t := 1 To 4 do
      szHelp := szHelp + Right('00'+inttostr(ord(Copy(FES_TIME,t,1)[1])),2);
    l := StrToInt('$'+ szHelp)  ;
    Datum := DateAdd('s',l,EncodeDate(1970,01,01))  ;
    szHelp := '';
    For t := 1 To 16 do
      szHelp := szHelp + Right('00'+inttostr(ord(copy(FES, t, 1)[1])), 2);
    end;
    List1.AddItem(FormatDateTime('hh:mm:ss dd.mm.yyyy',Datum) + ' -> ' + szHelp ;
  end;
  Stream.Free;
end;
end;

09/04/2007, 23h20
NapsterVB

salut ,
j'ai toujour cette erreur
72 la valeur affectée à DataAdd n'est jamais utuliser .
et merci
09/04/2007, 23h29
anapurna

salut

Tu as une erreur ?
tu as bien copier la fonction que j'ai ecrite ?

@+ Phil

1 pièce(s) jointe(s)

salut voila ce code toujour bug

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
 
uses DateUtils;
{$R *.dfm}
 
function Right(st : String;i : integer) : String;
begin
  Result := Copy(st,length(st)-i,i);
end;
type TStringsArray = array of string;
function Split(txt: string; delimit: char): TStringsArray;
var
  i: integer;
  deb: integer;
  idx: integer;
begin
  i := 1;
  deb := 1;
  idx := 0;
  txt := Trim(txt);
  SetLength(Result,0);
  while (i < length(txt)) do
  begin
    if (txt[i] = delimit) then
    begin
      SetLength(Result, idx +1);
      Result[idx] := copy(txt, deb, i - deb);
      deb := i;
      inc(idx);
    end;
    inc(i);
  end;
  if i <> deb then
  begin
    SetLength(Result, idx +1);
    Result[idx] := copy(txt, deb, length(txt));
  end;
end;
 
function DateAdd(interval : string;Quantity: Int64;ADate: TDateTime): TDateTime;
begin
  if ((length(interval) < 2) and (trim(interval) <> ''))  Then
  begin
  Case interval[1] of
  'd': Result := IncDay(ADate,Quantity);
//'y': Result := IncYear(ADate,Quantity);
  'h': Result := IncHour(ADate,Quantity);
  'n': Result := IncMinute(ADate,Quantity);
  'm': Result := IncMonth(ADate,Quantity);
  'q': Result := IncYear(ADate,Quantity);
  's': Result := IncSecond(ADate,Quantity);
//'w': Result := IncSecond(ADate,Quantity);
  end;
  end
  else
   if interval ='ww' Then
     Result := IncWeek(ADate,Quantity)
   else
     if interval ='yyyy' Then;
       Result := IncYear(ADate,Quantity);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  FES : String[16];
  FES_TIME : String[4];
  Datum : TDateTime;
  t : Integer;
//c : Integer;
  szHelp : String;
//szHelp2 : String;
  v : Variant;
  l : Longint;
  szFilename : String;
  Stream : TFileStream;
begin
  szFilename := ExtractFilepath(Application.ExeName) + '\Jugl.db';
  Stream := TFileStream.Create(szFilename,fmOpenRead);
  While Not(Stream.Size < Stream.Position) do
  begin
    Stream.Read(FES,length(FES));
    If (Stream.Size < Stream.Position) Then
      Exit;
    Stream.Read(FES_TIME,length(FES_TIME));
    szHelp := '';
    For t := 1 To 4 do
      szHelp := szHelp + Right('00'+inttostr(ord(Copy(FES_TIME,t,1)[1])),2);
    l := StrToInt('$'+ szHelp)  ;
    Datum := DateAdd('s',l,EncodeDate(1970,01,01))  ;
    szHelp := '';
    For t := 1 To 16 do
      szHelp := szHelp + Right('00'+inttostr(ord(copy(FES, t, 1)[1])), 2);
    end;
//    List1.AddItem(FormatDateTime('hh:mm:ss dd.mm.yyyy',Datum) + ' -> ' + szHelp ;
      List1.Items.Add(FormatDateTime('hh:mm:ss dd.mm.yyyy',Datum) + ' -> ' + szHelp );
  end;
  Stream.Free;
end;
end.

j'arrive pas a comprendre le problem !!
et voila le fichier de traitment ('jugl.db')

Il y a un probleme avec ta fonction Right:
Code:

1 2 3 4 function Right(st : String;i : integer) : String; begin Result := Copy(st,length(st)-i,i); end;
Remplaces la par celle-ci:
Code:

1 2 3 4 5 6 7 8 function Right(S: String; Count: integer): String; var IndexMax: Integer; begin IndexMax := Length(S)+1; if (Count < 0) or (Count > IndexMax) then Raise ERangeError.CreateFmt('Indice %d hors limite',[Count]); Result := Copy(S, IndexMax - Count, Count); end;
Elle retourne Count caracteres en partant du dernier caractere de la chaine transmise en argument.

Maintenant dans ton code, les fonctions Split et Right sont OK.