tools.pas

简单的线回归程序,目前本人认为是最好的标定程序

unit Tools;

interface

uses
  Classes,SysUtils,Registry,Windows,ComCtrls,ShellAPI,ShellCtrls,Forms,Math;
var
  Handle:HWND=0;
  AppPath:string;
  RootKey:Integer=HKEY_LOCAL_MACHINE;
  CurKey:string='';

function ExecuteFile(const FileName: string): THandle; overload;
function ExecuteFile(const FileName, Params, DefaultDir: string; ShowCmd: Integer): THandle; overload;
function GetAutoRun: boolean;
procedure SetAutoRun(Value: boolean);
procedure RegJre(java_home:string);
procedure MakeDsn(db, dsn: string);
function TrimDir(Dir: string): string;
function GetValueFromFile(FileName,Name:string;Tag:string=''):string;
function SetValueToFile(FileName,Name,Value:string;Tag:string=''):string;
procedure SetReadOnly(FinemName: string; ReadOnly: boolean);
procedure RegWrite(Root: DWORD; Key, Name, Value: string); overload;
procedure RegWrite(Key, Name, Value: string); overload;
procedure RegWrite(Name, Value: string); overload;
function RegRead(Name: string):string; overload;
function RegRead(Key, Name: string):string; overload;
function RegRead(Root: DWORD; Key, Name: string):string; overload;
function GetExpandedNodes(ShellTreeView1:TShellTreeView):string;
procedure SetExpandedNodes(ShellTreeView1:TShellTreeView;s:string);
procedure SetSelectedNode(ShellTreeView1:TShellTreeView;Path:string);
function GetPath(ShellTreeView1:TShellTreeView;Node:TTreeNode):string;
procedure AssociateFileExt(FileName, Ext: string);

implementation

function ExecuteFile(const FileName: string): THandle;
begin
  ExecuteFile(FileName, '', '', SW_SHOWDEFAULT);
end;

function ExecuteFile(const FileName, Params, DefaultDir: string; ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: array[0..MAX_PATH] of Char;
begin
  Result := ShellExecute(Application.MainForm.Handle, 'open',
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;

procedure SetAutoRun(Value: boolean);
begin
  if Value then
    RegWrite('Software\Microsoft\Windows\CurrentVersion\Run','easyjava', Application.ExeName)
  else
    RegWrite('Software\Microsoft\Windows\CurrentVersion\Run','easyjava', '');
end;

function GetAutoRun: boolean;
begin
  Result:=''<>RegRead('Software\Microsoft\Windows\CurrentVersion\Run','easyjava');
end;

procedure RegJre(java_home:string);
begin
  RegWrite('Software\JavaSoft\Java Runtime Environment','CurrentVersion','1.4.2');
  RegWrite('Software\JavaSoft\Java Runtime Environment\1.4.2','JavaHome',java_home+'\jre');
  RegWrite('RuntimeLib',java_home+'\jre\bin\client\jvm.dll');
  RegWrite('SOFTWARE\Classes\CLSID\{CAFEEFAC-0014-0002-0000-ABCDEFFEDCBB}\InprocServer32','',java_home+'\jre\bin\npjpi142.dll');
  RegWrite('ThreadingModel','Apartment');
end;

procedure MakeDsn(db, dsn: string);
var
  sysdir,DriverId,FIL:string;
  function IsMdb:Boolean;
  begin
    IsMdb:=ExtractFileExt(db)='.mdb';
  end;
  function IsXls:Boolean;
  begin
    IsXls:=ExtractFileExt(db)='.xls';
  end;
begin
  DriverId:='0';
  if IsMdb then
  begin
    DriverId:='25';
    FIL:='excel 8.0;';
  end;
  if IsXls then
  begin
    DriverId:='790';
    FIL:='MS Access;';
  end;
  if DriverId='0' then Exit;
  if pos(':',db)=0 then db:=TrimDir(AppPath+db);
  if not FileExists(db) then Exit;
  SetLength(sysdir,100);
  GetSystemDirectory(PChar(sysdir),100);
  sysdir:=PChar(sysdir);
  RegWrite('\SOFTWARE\ODBC\ODBC.INI\'+dsn,'DBQ',db);
  RegWrite('DefaultDir',ExtractFileDir(db));
  RegWrite('Driver',sysdir+'\odbcjt32.dll');
  RegWrite('DriverId',DriverId);
  RegWrite('FIL',FIL);
  RegWrite('SafeTransactions','0');
  RegWrite('SafeTransactions','0');
  RegWrite('ReadOnly','1');
  RegWrite('\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources',dsn,'Microsoft Access Driver (*.mdb)');
  RegWrite('\SOFTWARE\ODBC\ODBC.INI\'+dsn+'\Engines\Jet','ImplicitCommitSync','Microsoft Access Driver (*.mdb)');
  RegWrite('MaxBufferSize','$800');
  RegWrite('PageTimeout','5');
  RegWrite('Threads','3');
  RegWrite('UserCommitSync','Yes');

end;

function TrimDir(Dir: string): string;
var
  i,p:Integer;
begin
  Result:=Dir;
  Result:=StringReplace(Result,'/','\',[rfReplaceAll]);
  while Pos('..',Result)>0 do
  begin
    p:=Pos('..',Result);
    i:=p-2;
    while Result[i]<>'\' do Dec(i);
    Delete(Result,i,p+2-i);
  end;
end;

function SetValueToFile(FileName,Name,Value:string;Tag:string=''):string;
var
  i,p,start,stop:Integer;
  List:TStrings;
  xml:string;
begin
  Result:='';
  start:=0;
  stop:=0;
  List:=TStringList.Create;
  if not FileExists(FileName) then Exit;
  List.LoadFromFile(FileName);
  xml:=List.Text;
  p:=pos(Name,xml);
  if (p=0)and(Tag='') then Exit;
  if Tag<>'' then
    for i:=pos(Tag,xml) to MaxInt do
      if xml[i]='>' then
        begin
          if p>i then p:=0;
          break;
        end;
  if (p=0)and(Tag<>'') then
  begin
    p:=pos(Tag,xml);
    if p=0 then Exit;
    p:=p+Length(Tag)-1;
    xml:=Copy(xml,1,p)+' '+Name+'=""'+Copy(xml,p+1,MaxInt);
    p:=p+2;
  end;
  for i:=p to MaxInt do
    if xml[i]='"' then
    begin
      start:=i;
      Break;
    end;
  for i:=Start+1 to MaxInt do
    if xml[i]='"' then
    begin
      stop:=i;
      Break;
    end;
  Result:=Copy(xml,Start+1,Stop-Start-1);
  if Value='' then Exit;
  xml:=Copy(xml,1,p-1)+Name+'="'+Value+Copy(xml,stop,MaxInt);
  List.Text:=xml;
  List.SaveToFile(FileName);
end;

function GetValueFromFile(FileName,Name:string;Tag:string=''):string;
var
  i,p,p1,start,stop:Integer;
  List:TStrings;
  xml:string;
begin
  Result:='';
  start:=0;
  stop:=0;
  List:=TStringList.Create;
  if not FileExists(FileName) then Exit;
  List.LoadFromFile(FileName);
  xml:=List.Text;
  p:=pos(Name,xml);
  p1:=MaxInt;
  if Tag<>'' then
  begin
    p1:=pos(Tag,xml);
    p1:=p1-1+pos('>',copy(xml,p1,MaxInt));
  end;
  if (p=0)or(p>p1) then Exit;
  for i:=p to MaxInt do
    if xml[i]='"' then
    begin
      start:=i;
      Break;
    end;
  for i:=Start+1 to MaxInt do
    if xml[i]='"' then
    begin
      stop:=i;
      Break;
    end;
  Result:=Copy(xml,Start+1,Stop-Start-1);
end;

procedure SetReadOnly(FinemName: string; ReadOnly: boolean);
var
  Attrs:Integer;
begin
  Attrs := FileGetAttr(FinemName);
  if (not ReadOnly)and(Attrs and faReadOnly <> 0) then
    FileSetAttr(FinemName, Attrs - faReadOnly);
  if ReadOnly and (Attrs and faReadOnly = 0) then
    FileSetAttr(FinemName, Attrs + faReadOnly);

end;

procedure RegWrite(Name, Value: string); overload;
begin
  RegWrite(CurKey, Name, Value);
end;

procedure RegWrite(Key, Name, Value: string); overload;
begin
  CurKey:=Key;
  RegWrite(RootKey, Key, Name, Value);
end;

procedure RegWrite(Root: DWORD; Key, Name, Value: string); overload;
var
  R:TRegistry;
begin
  RootKey:=Root;
  CurKey:=Key;
  R := TRegistry.Create;
  R.RootKey := Root;
  R.OpenKey(Key, true);
  if Value='' then
    R.DeleteValue(Name)
  else if StrToIntDef(Value,-1)=-1 then
    R.WriteString(Name,Value)
  else R.WriteInteger(Name,StrToInt(Value));
  R.CloseKey;
  R.Free;
end;

procedure RegDelete(Root: DWORD; Key, Name: string); overload;
begin

end;

function RegRead(Name: string):string; overload;
begin
  Result:=RegRead(CurKey, Name);
end;

function RegRead(Key, Name: string):string; overload;
begin
  Result:=RegRead(RootKey, Key, Name);
end;

function RegRead(Root: DWORD; Key, Name: string):string; overload;
var
  R:TRegistry;
begin
  RootKey:=Root;
  CurKey:=Key;
  R := TRegistry.Create;
  R.RootKey := Root;
  if not R.OpenKey(Key, false) then
  begin
    Result:='';
    Exit;
  end;
  Result:=R.ReadString(Name);
  R.CloseKey;
  R.Free;
end;

function GetExpandedNodes(ShellTreeView1:TShellTreeView):string;
var
  i:Integer;
  Node:TTreeNode;
begin
  Result:='';
  for i:=1 to ShellTreeView1.Items.Count-1 do
  begin
    Node:=ShellTreeView1.Items[i].Parent;
    if (Node<>nil)and(not Node.Expanded) then Continue;
    Node:=Node.Parent;
    if (Node<>nil)and(not Node.Expanded) then Continue;
    if ShellTreeView1.Items[i].Expanded then Result:=Result+'1'
    else Result:=Result+'0';
  end;

end;

procedure SetExpandedNodes(ShellTreeView1:TShellTreeView;s:string);
var
  i:Integer;
begin
  for i:=1 to Min(Length(s),ShellTreeView1.Items.Count-1) do
    if s[i]='1' then ShellTreeView1.Items[i].Expand(False);
end;

procedure SetSelectedNode(ShellTreeView1:TShellTreeView;Path:string);
var
  i:Integer;
  CurPath:string;
begin
  for i:=0 to ShellTreeView1.Items.Count-1 do
  begin
    CurPath:=GetPath(ShellTreeView1,ShellTreeView1.Items[i]);
    if Pos(CurPath,Path)+Length(CurPath)=Length(Path)+1 then
    begin
      ShellTreeView1.Selected:=ShellTreeView1.Items[i];
      Break;
    end;
  end;
end;

function GetPath(ShellTreeView1:TShellTreeView;Node:TTreeNode):string;
begin
  Result:=Node.Text;
  while Node<>ShellTreeView1.Items[0] do
  begin
    Node:=Node.Parent;
    Result:=Node.Text+'\'+Result;
  end;
end;

procedure AssociateFileExt(FileName, Ext: string);
var
  FileClass:string;
begin
  FileClass:=Ext+'file';
  RegWrite(HKEY_CLASSES_ROOT,'.'+Ext,'',FileClass);
  RegWrite(FileClass+'\Shell\Open\Command','',FileName+' %1');
end;

initialization
  AppPath:=ExtractFilePath(Application.ExeName);

end.