unitbeifen.pas

信号机测试信号管理软件 其中含有文件上传及修改数据库数据的功能

unit Unitbeifen;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,Consts, FileCtrl;

type
EInvalidDest = class(EStreamError);
  EFCantMove = class(EStreamError);

  TFormbeifen = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
   // procedure CopyFile(const FileName, DestName: string);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Formbeifen: TFormbeifen;

implementation
uses  unitmodule,ShellAPI;
const
  SInvalidDest = 'Destination %s does not exist';
  SFCantMove = 'Cannot move file %s';

{$R *.dfm}

Function GetLastFIXED:char;
var
  Ch : Char;
  S  : string;
begin
  for Ch := 'C' to 'Z' do
  begin
    s := Ch + ':\';
    if GetDriveType(PChar(s)) = DRIVE_FIXED then
    Begin
      Result:=ch;
    End;
  end;
End;




procedure TFormbeifen.FormCreate(Sender: TObject);
begin
    edit1.Text:=GetLastFIXED;
end;

procedure TFormbeifen.Button1Click(Sender: TObject);
var
filename,copyfile:string;
NewFileName: string;
Msg: string;
NewFile: TFileStream;
OldFile: TFileStream;
begin
    copyfile:=GetLastFIXED+':\'+'signal_2007-07-06.mdb'; //暂定将它放在最后一个硬盘的盘符下,若要将它放在某一文件夹下,需先创建该文件
    filename:=ExtractFiledir(Application.ExeName)+'\'+'database'+'\'+'signal_2007-07-06.mdb';
    if  FileExists(filename)  then
    begin
    NewFileName := copyfile;
    Msg := Format('Copy %s to %s?', [filename, copyfile]);
    if MessageDlg(Msg, mtCustom, mbOKCancel, 0) = mrOK then           //弹出对话框,提示是否要复制
    begin
        datamodule2.ADOConnection1.Connected:=false;
        OldFile := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
        try
        NewFile := TFileStream.Create(copyfile, fmCreate or fmShareDenyRead);

            try
                NewFile.CopyFrom(OldFile, OldFile.Size);
            finally
                FreeAndNil(NewFile);
                showmessage('备份成功,原文件已被覆盖');
            end;
        finally
        FreeAndNil(OldFile);
        end;
    end;
    end
    else showmessage('no file');
end;

procedure TFormbeifen.Button2Click(Sender: TObject);
begin
 inherited;
  close();
end;

end.