udbm.pas

数据库通用工具

  DriverId=25;
  Exclusive=1;
  FIL=MS Access;
  MaxBufferSize=2048;
  MaxScanRows=8;
  PageTimeout=5;
  ReadOnly=0;
  SafeTransactions=0;
  Threads=3;
  UID=admin;
  UserCommitSync=Yes;"
  //}

  //adocLink.ConnectionString := 'Provider=MSDASQL.1;Password=why;'+
  //    'Persist Security Info=True;User ID=admin;Extended Properties="'+
  //    'DBQ='+vdir+'cardBase.mdb;'+
  //    'Driver={Microsoft Access Driver (*.mdb)};'+
  //    'DriverId=25;Exclusive=1;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;'+
  //    'PageTimeout=5;ReadOnly=0;SafeTransactions=0;Threads=3;UID=admin;"';
  //}
//  mdbUser := 'admin';
//  mdbPass := '';

  adocLink.ConnectionString := 'Provider=MSDASQL.1;Password='+mdbPass+';'+
      'Persist Security Info=True;User ID='+mdbUser+';Extended Properties="'+
      'DBQ='+sPathName+';'+
      'Driver={Microsoft Access Driver (*.mdb)};'+
      'DriverId=25;Exclusive=1;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;'+
      'PageTimeout=5;ReadOnly=0;SafeTransactions=0;Threads=3;UID='+mdbUser+';"';

  try
    adocLink.Connected := true;
  except
    exit;
  end;

  Result := adocLink.Connected;
  {
  slt := TStringList.Create();
  adocLink.GetTableNames(slt,false);//B
  for i := 0 to slt.Count-1 do
  begin
    ss := slt.Strings[i];
    //ss := copy(ss,5,length(ss)-4);
    cbxTable.Items.Add( ss );
  end;
  slt.Free;
  //}
end;

procedure Tdbm.DataModuleCreate(Sender: TObject);
begin
  appPath := ExtractFileDir(Application.ExeName);
  sys32Path := GetSysPath();
end;

procedure Tdbm.listODBCs( sl : TStrings );
var
  TheReg : TRegistry;
//  Names : TStringList;
begin
  inherited;
//  Session.GetAliasNames(Memo1.Lines) ;
  TheReg := TRegistry.Create;
  TheReg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if TheReg.OpenKey( '\software\odbc\odbc.ini\ODBC Data Sources',false ) then
    begin                        
      TheReg.GetValueNames( sl );
    end;
  finally   
    TheReg.Free;
  end;
end;

function getFieldTypeSQL( sDPName : string ) : string;
begin
  sDPName := Trim(sDPName);
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TWideStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := 'float';
  end
  else if sDPName='TCurrencyField' then
  begin
    Result := 'money';
  end
  else if sDPName='TBCDField' then
  begin
    Result := 'money';
  end
  else if sDPName='TDateTimeField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TBooleanField' then
  begin
    Result := 'bit';
  end
  else if sDPName='TBlobField' then
  begin
    Result := 'image';
  end
  else if sDPName='TAutoIncField' then
  begin
    Result := 'int (自增)';
  end
  else if sDPName='TSmallintField' then
  begin
    Result := 'smallint';
  end
  else if sDPName='TMemoField' then
  begin
    Result := 'text';
  end
  else
  begin
    //TWordField
    //TBytesField
//    Result := '-【'+sDPName+'】-';
    Result := '--';
  end;

end;

function getFieldTypeMySQL( sDPName : string ) : string;
begin
  sDPName := Trim(sDPName);
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TWideStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := 'float';
  end
  else if sDPName='TCurrencyField' then
  begin
    Result := 'money';
  end
  else if sDPName='TBCDField' then
  begin
    Result := 'money';
  end
  else if sDPName='TDateTimeField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TBooleanField' then
  begin
    Result := 'bit';
  end
  else if sDPName='TBlobField' then
  begin
    Result := 'image';
  end
  else if sDPName='TAutoIncField' then
  begin
    Result := 'int (自增)';
  end
  else if sDPName='TSmallintField' then
  begin
    Result := 'smallint';
  end
  else if sDPName='TMemoField' then
  begin
    Result := 'text';
  end
  else
  begin
    //TWordField
    //TBytesField
//    Result := '-【'+sDPName+'】-';
    Result := '--';
  end;

end;

function getFieldTypeAccess( sDPName : string ) : string;
begin
  sDPName := Trim(sDPName);
  {
文本          | varchar【50】   | TWideStringField
备注          | text【0】       | TMemoField
数字          | int【0】        | TIntegerField
日期/时间     | datetime【0】   | TDateTimeField
货币          | money【4】      | TBCDField
自动编号      | int(自增)【0】  | TAutoIncField
是/否         | bit【0】        | TBooleanField
OLE 对象      | image【0】      | TBlobField
超级链接      | text【0】       | TMemoField
数字(查阅向导)| int【0】        | TIntegerField
  }
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TWideStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := 'float';
  end
  else if sDPName='TBCDField' then
  begin
    Result := 'money';
  end
  else if sDPName='TCurrencyField' then
  begin
    Result := 'money';
  end
  else if sDPName='TDateTimeField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TBooleanField' then
  begin
    Result := 'bit';
  end
  else if sDPName='TBlobField' then
  begin
    Result := 'image';
  end
  else if sDPName='TAutoIncField' then
  begin
    Result := 'int(自增)';
  end
  else if sDPName='TSmallintField' then
  begin
    Result := 'smallint';
  end
  else if sDPName='TMemoField' then
  begin
    Result := 'text';
  end
  else
  begin
    Result := '--';
  end;

end;

function getFieldTypeDB2( sDPName : string ) : string;
begin
  sDPName := Trim(sDPName);
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TWideStringField' then//TStringField
  begin
    Result := 'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := 'float';
  end
  else if sDPName='TCurrencyField' then
  begin
    Result := 'money';
  end
  else if sDPName='TDateField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TDateTimeField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TBooleanField' then
  begin
    Result := 'bit';
  end
  else if sDPName='TBlobField' then
  begin
    Result := 'image';
  end
  else if sDPName='TAutoIncField' then
  begin
    Result := 'int (自增)';
  end
  else if sDPName='TSmallintField' then
  begin
    Result := 'smallint';
  end
  else if sDPName='TMemoField' then
  begin
    Result := 'text';
  end
  else//'TDateField'
  begin
    Result := '-【'+sDPName+'】-';
  end;

end;

function FullString(Const Source,Seep:String; Const Number:Integer; Const bLeftAdd:Boolean=True ): String;
var
  TempStr:String;
  i:integer;
begin
  TempStr:=Source;
  For i:=length(Source) to Number-1 do
  begin
    if bLeftAdd then//左补
      TempStr := Seep+TempStr
    else//右补
      TempStr := TempStr+Seep;
  end;
  Result := TempStr;
  
end;

//fri变量，只能包含有 小数点、空格、 '/'、数字。如 1 1/2 或1.2
function fri2decimal(fri: string): double;
var
  strs: TStrings;
  fri_dec: double;
  function csubstr(substr: string; str: string): integer;
  var
    i, j: integer;
  begin
    j := 0;
    for i := 1 to length(str) do
      if str[i] = substr then j := j + 1;
    result := j;
  end;

  function onlydecimal(str_fri: string): double;
  begin
     //2.只有小数点、没有空格、'/'  如有只一个小数点，则直接转换，如有多个小数点，全部去掉后转换
    if csubstr('.', str_fri) <> 1 then //一个小数点的保留
      str_fri := StringReplace(str_fri, '.', '', [rfReplaceAll]); //多个小数点全去掉
    result := strtofloat(str_fri);
  end;

  function onlyspace(str_fri: string): double;
  begin
    //3.只有空格、没有小数点、'/'  去除全部空格后转换
    str_fri := StringReplace(str_fri, ' ', '', [rfReplaceAll]);
    result := strtofloat(str_fri);
  end;

  function onlyxg(str_fri: string): double;
  begin
   //4.只有'/'、没有小数点、空格 ，如'/'在头，在尾，或多个都全部去掉，只有一个的进行除运算,如分母为0的，仅对分子进行转换
   //如果/在头与尾,或超过1个则去掉/
    if (pos('/', str_fri) = 1) or (pos('/', str_fri) = length(str_fri)) or (csubstr('/', str_fri) <> 1) then
    begin
      str_fri := StringReplace(str_fri, '/', '', [rfReplaceAll]);
      result := strtofloat(str_fri);
    end
    else
    begin //如果在中间，进行除法运算
      strs := TStringList.Create;
      strs.Delimiter := '/';
      strs.DelimitedText := str_fri;
      if strtofloat(strs[1]) = 0 then //如分母为0的，仅对分子进行转换
        result := strtofloat(strs[0])
      else        //use Math
        result := roundto(strtofloat(strs[0]) / strtofloat(strs[1]), -5);
      strs.Free;
    end;
  end;

  function spacexg(str_fri: string): double;
  begin
    if (pos('/', str_fri) = 1) or (pos('/', str_fri) = length(str_fri)) or (csubstr('/', str_fri) <> 1) then //如果/在最前与最后，去掉/
    begin ///在最前与最后，或多个/去掉/
      str_fri := StringReplace(str_fri, '/', '', [rfReplaceAll]);
      result := onlyspace(str_fri);
    end
    else if (pos('/', str_fri) < pos(' ', str_fri)) or (csubstr(' ', str_fri) <> 1) then //如果/在空格前面，去除空格，按分数计算
    begin //如果/在空格前，或多个空格 去掉空格
      str_fri := StringReplace(str_fri, ' ', '', [rfReplaceAll]);
      result := onlyxg(str_fri);
    end
    else
    begin
      strs := TStringList.Create;
      strs.Delimiter := ' ';
      strs.DelimitedText := str_fri;
      result := strtofloat(strs[0]) + onlyxg(strs[1]);
    end;
  end;
begin
  result := 0;

  //1.空格、小数点、'/' 都没有 直接转换为小数
  if (pos(' ', fri) = 0) and (pos('.', fri) = 0) and (pos('/', fri) = 0) then
    result := strtofloat(fri);

  //2.只有小数点、没有空格、'/'  如有只一个小数点，则直接转换，如有多个小数点，全部去掉后转换
  if (pos(' ', fri) = 0) and (pos('.', fri) <> 0) and (pos('/', fri) = 0) then
    result := onlydecimal(fri);

  //3.只有空格、没有小数点、'/'  去除全部空格后转换
  if (pos(' ', fri) <> 0) and (pos('.', fri) = 0) and (pos('/', fri) = 0) then
    result := onlyspace(fri);

  //4.只有'/'、没有小数点、空格 ，如'/'在头，在尾，或多个都全部去掉，只有一个的进行除运算,如分母为0的，仅对分子进行转换
  if (pos(' ', fri) = 0) and (pos('.', fri) = 0) and (pos('/', fri) <> 0) then
    result := onlyxg(fri);

  //5.有小数点 有空格，没有'/'   去掉空格，按小数来来计算
  if (pos(' ', fri) <> 0) and (pos('.', fri) <> 0) and (pos('/', fri) = 0) then
  begin
    fri := StringReplace(fri, ' ', '', [rfReplaceAll]);
    result := onlydecimal(fri);
  end;

  //6.有'/',有小数点 没空格， 去掉小数点，按/来来计算
  if (pos(' ', fri) = 0) and (pos('.', fri) <> 0) and (pos('/', fri) <> 0) then
  begin
    fri := StringReplace(fri, '.', '', [rfReplaceAll]);
    result := onlyxg(fri);
  end;

  //7.有'/',有空格 没小数点，
  if (pos(' ', fri) <> 0) and (pos('.', fri) = 0) and (pos('/', fri) <> 0) then
    result := spacexg(fri);

  //8.有'/',有空格 有小数点，  去除小数点，按7来算
  if (pos(' ', fri) <> 0) and (pos('.', fri) <> 0) and (pos('/', fri) <> 0) then
  begin
    fri := StringReplace(fri, '.', '', [rfReplaceAll]);
    result := spacexg(fri);
  end;
end;

function Fraction(decimal: double): string;
var
  intNumerator, intDenominator, intNegative: integer; // 声明整数变量为长整数
  dblFraction, dblDecimal, dblAccuracy, dblinteger: Double; // 声明浮点数为双精度
begin
  //十进制小数转分数（无下载）
  {
原作者
Written by:     Erik Oosterwal
'   Started on:     November 9, 2005
'   Completed on:   November 9, 2005
增加大于1的小数的转化
小数到分数的转化

By Erik Oosterwal   翻译： Zoologist

  下面将介绍一种小数转化为分数的简单方法，这种方法能将十进制的小数转化为分子与分
  母都是整数的分数，换句话说，这个算法能够自动判定循环节。任何十进制数值都能被转
  化为一个指定精度的分数。

  这个算法的根本原理是：一个分数对应一条直线的斜率。用数学语言描述就是：一条直线
  的斜率是无穷大(垂直于X轴)或者是(Y2-Y1) / (X2-X1)，我们要做的就是找到2个整数，
  在指定的精度范围内接近这个斜率。对于正数来说，我们设置分子为0，分母为1，然后比
  较这个分数同给定的十进制数。如果我们的分数太小了（比如，我们选择的点在直线的下
  面），我们就加大分子的值直到这个分数太大（比如，这个点在直线的上方），之后我们
  在增加分母的大小直到这个点在直线下方。

  如果我们的最终目标是无理数（无限不循环小数），这个算法将一直继续，增加分子和分
  母，直到最终结果在指定的精度上。
  }
  dblDecimal := decimal; //取得目标小数
  if trunc(decimal) = decimal then // 如果是整数，则直转
    result := floattostr(decimal)
  else
  begin
    if abs(decimal) > 1 then //如果小数大于1 如 10.24 ，进行拆解
    begin
      dblinteger := trunc(decimal); //取出整数部分
      dblDecimal := abs(frac(decimal)); //取出小数部分
    end
    else dblDecimal := decimal;

    dblAccuracy := 0.01; //设置精度
    intNumerator := 0; //初始分子为0
    intDenominator := 1; //初始分母为1
    intNegative := 1; //符号标记为正
    if dblDecimal < 0 then intNegative := -1; //如果目标为负，设置负标志位
    dblFraction := 0; //设置分数值为 0/1
    while Abs(dblFraction - dblDecimal) > dblAccuracy do //如果当前没有达到精度要求就继续循环
    begin
      if Abs(dblFraction) > Abs(dblDecimal) then //如果我们的分数大于目标
        intDenominator := intDenominator + 1 //增加分母
      else //否则
        intNumerator := intNumerator + intNegative; //增加分子
      dblFraction := intNumerator / intDenominator; //计算新的分数
    end;
   // edit2.Text := inttostr(intNumerator) + '/' + inttostr(intDenominator);
    if abs(decimal) > 1 then //如果小数大于1 如 10.24 ，进行拆解
      result := floattostr(dblinteger) + ' ' + inttostr(intNumerator) + '/' + inttostr(intDenominator)
    else
      result := inttostr(intNumerator) + '/' + inttostr(intDenominator);
  end;
end;

end.