untclassical.pas

计算采集到的GPS距离计算亮点间的距离从GPS中提取数据等

unit untClassical;

interface
uses
  Windows, SysUtils, Classes, Math, ComObj, ActiveX;

implementation

const
  Ea = 6378137; // 赤道半径 WGS84标准参考椭球中的地球长半径(单位:m)
  Eb = 6356725; // 极半径
  SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
                              +'Jet OLEDB:Database Password=%s;';

//根据注册表数据得到串口列表
procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE,
    'HARDWARE\DEVICEMAP\SERIALCOMM',
    0,
    KEY_READ,
    KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(
        KeyHandle,
        Index,
        PChar(ValueName),
        Cardinal(ValueLen),
        nil,
        @ValueType,
        PByte(PChar(Data)),
        @DataLen);

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else
        if ErrCode <> ERROR_NO_MORE_ITEMS then
          exit; //raise EComPort.Create(CError_RegError, ErrCode);

    until (ErrCode <> ERROR_SUCCESS) ;

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;

end;

//16进制字符串转换成字符串
function HexStrToStr(const S:string):string;
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin   
    while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
      inc(t);
    if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$'+S[t]
    else
      ts:='$'+S[t]+S[t+1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result+Chr(M);
    inc(t,2);
  end;
end;

//字符串转换成16进制字符串
function StrToHexStr(const S:string):string;
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)
    else Result:=Result+' '+IntToHex(Ord(S[I]),2);
  end;
end;

//将GPS值的度分表示法转换为纯度表示法
function GPSStrToFloat(aData:string):double;
var
  tempFloat:double;
begin
  Result := 0.0;
  try
    tempFloat := StrToFloat(aData) / 100.0;
    Result := Int(tempFloat) + Frac(tempFloat) * 100.0 / 60.0;
  except
  end;
end;

//将GPS值的纯度表示法转换为度分表示法
function GPSFlostToStr(aData:double):string;
var
  tempFloat:double;
begin
  Result := '';
  try
    tempFloat := Int(aData) * 100;
    tempFloat := tempFloat + Frac(aData) * 60;
    Result := Format('%.4f',[tempFloat]);
  except
  end;
end;

//角度转化为弧度值,输入角度,返回弧度值
function AngleToRadian(AAngle:double):double;
begin
  Result := AAngle * PI / 180;
end;

//计算地球上两点自间的距离,输入开始点,结束点的角度表示的经纬度值,返回两点自荐的距离
function GetDistance(StartLongitude,StartLatitude,EndLongTitude,EndLatitude:double):double;
var
  StartLngRad,StartLatRad,EndLngRad,EndLatRad:double;
  LngDiff,LatDiff:double;
  dx,dy:double;
  Ec,Ed:double;
begin
  //转换为弧度
  StartLngRad := AngleToRadian(StartLongitude);
  StartLatRad := AngleToRadian(StartLatitude);
  EndLngRad := AngleToRadian(EndLongTitude);
  EndLatRad := AngleToRadian(EndLatitude);
  //求差
  LngDiff := abs(StartLngRad - EndLngRad);
  LatDiff := abs(StartLatRad - EndLatRad);

  Ec := Eb + (Ea - Eb) * (90 - StartLatitude) / 90;
  Ed := Ec * Cos(StartLatRad);

  dx := LngDiff * Ed;
  dy := LatDiff * Ec;
  Result := Sqrt(dx * dx + dy *dy) / 1000;
end;

//=============================================================================
// Procedure: GetTempPathFileName
// Author : ysai
// Date : 2003-01-27
// Arguments: (None)
// Result : string
//=============================================================================
function GetTempPathFileName():string;
//取得临时文件名
var
SPath,Sfile:array [0..254] of char;
begin
  GetTempPath(254,SPath);
  GetTempFileName(SPath,'~SM',0,SFile);
  result:=SFile;
  DeleteFile(PChar(result));
end;

//=============================================================================
// Procedure: CreateAccessFile
// Author : ysai
// Date : 2003-01-27
// Arguments: FileName:String;PassWord:string=''
// Result : boolean
//=============================================================================
function CreateAccessFile(FileName:String;PassWord:string=''):boolean;
//建立Access文件，如果文件存在则失败
var
STempFileName:string;
vCatalog:OleVariant;
begin
  STempFileName:=GetTempPathFileName;
  try
    vCatalog:=CreateOleObject('ADOX.Catalog');
    vCatalog.Create(format(SConnectionString,[STempFileName,PassWord]));
    result:=CopyFile(PChar(STempFileName),PChar(FileName),True);
    DeleteFile(PChar(STempFileName));
  except
    result:=false;
  end;
end;

//=============================================================================
// Procedure: CompactDatabase
// Author : ysai
// Date : 2003-01-27
// Arguments: AFileName,APassWord:string
// Result : boolean
//=============================================================================
function CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
var
STempFileName:string;
vJE:OleVariant;
begin
  STempFileName:=GetTempPathFileName;
  try
    vJE:=CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
    format(SConnectionString,[STempFileName,APassWord]));
    result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
    DeleteFile(PChar(STempFileName));
  except
    result:=false;
  end;
end;

//=============================================================================
// Procedure: ChangeDatabasePassword
// Author : ysai
// Date : 2003-01-27
// Arguments: AFileName,AOldPassWord,ANewPassWord:string
// Result : boolean
//=============================================================================
function ChangeDatabasePassword(AFileName,AOldPassWord,ANewPassWord:string):boolean;
//修改ACCESS数据库密码
var
STempFileName:string;
vJE:OleVariant;
begin
  STempFileName:=GetTempPathFileName;
  try
    vJE:=CreateOleObject('JRO.JetEngine');
    vJE.CompactDatabase(format(SConnectionString,[AFileName,AOldPassWord]),
    format(SConnectionString,[STempFileName,ANewPassWord]));
    result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
    DeleteFile(PChar(STempFileName));
  except
    result:=false;
  end;
end;

end.