darnau
|
unit LOGGPS;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Dessin, uDm;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
Button1: TButton;
Edit1: TEdit;
Ed_type: TEdit;
Label1: TLabel;
Ed_Xmin: TEdit;
Label2: TLabel;
Label3: TLabel;
Ed_Ymin: TEdit;
Label4: TLabel;
Ed_Xmax: TEdit;
Label5: TLabel;
Label6: TLabel;
Ed_Ymax: TEdit;
Ed_Version: TEdit;
Label7: TLabel;
Button2: TButton;
Memo1: TMemo;
Ed_FileLength: TEdit;
procedure Button1Click(Sender: TObject);
function HexToDouble(i64 : int64): string;
function HexToInt (Value:string) : Integer;
procedure Button2Click(Sender: TObject);
function DoubleToInt(Value: string) : String;
procedure TraitementHeader();
procedure TraitementFichier();
function Lire(Position : integer; Boucle : integer; mode:string) : string;
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
f : TFileStream;
l, c, PosActual: Integer;
num, o , Inutile: String;
Premier : Boolean ;
Form1: TForm1;
FileName : string;
ShapeType: string;
implementation
{$R *.dfm}
procedure Tform1.TraitementFichier();
var
Index, X : integer;
chaine : string;
begin
Inutile:=IntToStr(HexToInt(Lire(PosActual,4,'Big')));
Memo1.Lines.Add(Inutile);
Index:= Memo1.Lines.IndexOf(Inutile);
Memo1.lines.add(Lire(PosActual,4,'Big'));
ShapeType:=Lire(PosActual, 4, 'Little');
if ShapeType = '00000001' then begin
chaine:=HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+''' , '''+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')));
dm.QMBR2.close;
dm.QMBR2.SELECTSql.Clear;
dm.QMBR2.SELECTsql.add('INSERT INTO POINT (X, Y) VALUES ('''+chaine+''')');
dm.QMBR2.open;
dm.TRMBR.CommitRetaining;
//Memo1.Lines[Index]:=Memo1.Lines[Index]+ ' - Point : ' ;
//Memo1.lines.add(HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+ ' - '+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little'))));
end
else if ShapeType = '00000005' then begin
Memo1.Lines[Index]:=Memo1.Lines[Index]+ ' - MBR : ' ;
Memo1.lines.add(HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+ ' - '+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+ ' - '+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+ ' - '+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little'))));
Memo1.lines.add(IntToStr(HexToInt(Lire(PosActual, 4, 'Little'))));
Memo1.lines.add(IntToStr(HexToInt(Lire(PosActual, 4, 'Little'))));
Memo1.lines.add(IntToStr(HexToInt(Lire(PosActual, 4, 'Little'))));
chaine:=HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+''' , '''+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')));
dm.QMBR2.close;
dm.QMBR2.SELECTSql.Clear;
dm.QMBR2.SELECTsql.add('INSERT INTO POINT (X, Y) VALUES ('''+chaine+''')');
dm.QMBR2.open;
dm.TRMBR.CommitRetaining;
chaine:='';
chaine:=HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+''' , '''+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')));
dm.QMBR2.close;
dm.QMBR2.SELECTSql.Clear;
dm.QMBR2.SELECTsql.add('INSERT INTO POINT (X, Y) VALUES ('''+chaine+''')');
dm.QMBR2.open;
dm.TRMBR.CommitRetaining;
x:=x+1;
// Avec donc 361 fois l'instruction précédente le code fonctionne et rendre les données dans la base...
{
x:=0;
while x < 360 do
begin
chaine:=HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')))+''' , '''+HexToDouble(StrToInt64('$'+Lire(PosActual, 8, 'Little')));
dm.QMBR2.close;
dm.QMBR2.SELECTSql.Clear;
dm.QMBR2.SELECTsql.add('INSERT INTO POINT (X, Y) VALUES ('''+chaine+''')');
dm.QMBR2.open;
dm.TRMBR.CommitRetaining;
x:=x+1;
end;
}
end;
end;
procedure Tform1.TraitementHeader();
Var
FileLength : Extended;
chaine : string;
test: integer;
begin
Edit1.Text:=Lire(PosActual,2,'Big');
Inutile:=Lire(PosActual,20, 'Big');
Ed_FileLength.Text:=Lire(PosActual,4,'Big');
FileLength:=HexToInt(Ed_FileLength.Text);
Ed_FileLength.Text:=FloatToStr(FileLength/2);
Ed_Version.Text:=Lire(PosActual,4, 'Little');
Ed_type.Text:=Lire(PosActual,4, 'Little');
if StrToInt(Ed_type.Text) = 1 then begin
Label1.Caption:='C''est un point';
ShapeType:='00000001';
end
else if StrToInt(Ed_type.Text) = 5 then begin
Label1.Caption:= 'C''est des polygones';
ShapeType:='00000005';
end;
Ed_Xmin.Text:=Lire(PosActual, 8, 'Little');
Ed_Ymin.Text:=Lire(PosActual,8, 'Little');
Ed_Xmax.Text:=Lire(PosActual,8, 'Little');
Ed_Ymax.text:=Lire(PosActual,8, 'Little');
Edit1.Text:=IntToStr(HexToInt(Edit1.Text));
Ed_Xmin.Text:=(HexToDouble(StrToInt64('$'+Ed_Xmin.Text)));
Ed_Ymin.Text:=(HexToDouble(StrToInt64('$'+Ed_Ymin.Text)));
Ed_Xmax.Text:=(HexToDouble(StrToInt64('$'+Ed_Xmax.Text)));
Ed_Ymax.Text:=(HexToDouble(StrToInt64('$'+Ed_Ymax.Text)));
Ed_Version.Text:=IntToStr(HexToInt(Ed_Version.Text));
CHAINE:=Ed_Xmin.Text+''','''+Ed_Xmax.Text+''','''+Ed_Ymin.Text+''','''+Ed_Ymax.Text;
dm.QMBR2.close;
dm.QMBR2.SELECTSql.Clear;
test:=dm.QMBR2.SELECTsql.add('INSERT INTO MBR (XMIN, XMAX, YMIN, YMAX) VALUES ('''+chaine+''')');
Memo1.Lines.Add(dm.QMBR2.SelectSQL[test]);
//dm.QMBR2.SELECTsql.Add(' VALUES('+chaine+')');
dm.QMBR2.open;
dm.TRMBR.CommitRetaining;
end;
function Tform1.Lire(Position : integer; Boucle : integer; mode:string) : string;
var
c : Integer;
begin
PosActual:=PosActual+Boucle;
f.Position := Position;
SetLength(o, 16);
f.Read(o[1], 16);
if mode = 'Big' then begin
for c:=1 to Boucle do begin
Result:=Result+IntToHex(ord(o[c]),2);
end;
end
else begin
c:=Boucle;
while c <> 0 do begin
Result:=Result+IntToHex(ord(o[c]),2);
c:=c-1;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
PosActual:=2;
Edit1.Text:='';
Ed_type.Text:='';
Ed_Xmin.text:='';
Ed_Ymin.Text:='';
Ed_Xmax.Text:='';
Ed_Ymax.Text:='';
Ed_Version.Text:='';
premier:=true;
if OpenDialog1.Execute then begin
FileName:=OpenDialog1.FileName;
f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
TraitementHeader();
PosActual:=PosActual+32;
while PosActual < HexToInt(Ed_FileLength.Text) do
TraitementFichier();
end;
end;
function TForm1.HexToDouble(i64 : int64): string;
var
r: Double absolute i64; // r a donc la même adresse que i64, et tous les 2 sont codés sur 8 octets
begin
// on affecte l'un des deux
//ShowMessage(FloatToStr(r)); // et on lit l'autre...
result:=FloatToStr(r) ;
end;
Function TForm1.HexToInt (Value:string) : Integer;
begin
result := StrToInt('$'+ Value);
end;
function TForm1.DoubleToInt(Value : string) : string;
var i : integer;
ResultTemp :string;
begin
ResultTemp := '';
for i:=1 to 32 do begin
if Value[i] = ',' then
break
Else
ResultTemp:=ResultTemp+Value[i];
end;
Result:=ResultTemp;
end;
end.
Le message d'erreur quand je remplace les instruction par une boucle for ou while:
Le projet ProjLOGGPS.exe a provoqué une classe d'exception EConvertError avec le message "$4013F8468F781F3D4013F85B882DA821' n'esr pas une valeur entière correcte'. Processus stoppé. Utilisez Pas-à-pas ou Exécuter pour continuer.
|