求救.一个cmd line小程序.

[episome]

早年学过一点 pascal, 现在都不记得了.
现在想要一个小东西. 就是比较两个目录,
如果文件存在于目标目录并且size相同,而且修改时间相同,则跳过,否则拷贝.
如果目标目录文件不存在于源目录,则删除.
这样可以方便备份工作.
写了一点,写不下去了, 毕竟不熟悉.

program checkout;

{$APPTYPE CONSOLE}
uses
Windows,
Classes,
SysUtils;


// isDir
function isDir(SearchRec:TSearchRec):Boolean;
begin
Result:= (SearchRec.Attr=16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..');
end;
// check file
procedure checkfile(sFile:String;pFile:String);
begin
if not FileExists(pFile) then
begin
copyFile(pchar(sFile),pchar(pFile),true);
writeln("Copy ",sFile,' to ',pFile);
end;

end;
// checkout
procedure checkouter(sPath:String ; dPath:String);
var
SearchRec:TSearchRec;
subdir:TStrings;
i:integer;
begin
subdir:=TStringList.Create;
sPath := IncludeTrailingPathDelimiter(sPath);
dPath := IncludeTrailingPathDelimiter(dPath);
if (FindFirst( sPath + '*.*', faDirectory, SearchRec)=0) then
begin
if isDir(SearchRec) then
begin
subdir.Add(SearchRec.Name);
end;
while FindNext(SearchRec) = 0 do
begin
if isDir(SearchRec) then
begin
subdir.Add(SearchRec.Name);
end;
end;
end;
FindClose(SearchRec);
FindFirst(sPath + '*.*',faAnyFile - faDirectory,SearchRec);
if(not isDir(SearchRec))then checkfile(sPath + SearchRec.Name,dPath + SearchRec.Name);
while FindNext(SearchRec)=0 do checkfile(sPath + SearchRec.Name,dPath + SearchRec.Name);
FindClose(SearchRec);

for i:=0 to subdir.Count-1 do
begin
checkouter(sPath + subdir.Strings[i]+ '\', dPath + subdir.Strings[i] + '\');
end;
subdir.Free;
end;

begin
writeln;
if ParamCount < 2 then
begin
writeln(' Useage: checkout.exe source destination [/q]');
Halt;
end;
if not DirectoryExists(ParamStr(1)) then
begin
writeln('Source directory ',ParamStr(1),' is not a valid path!');
Halt;
end;
if not DirectoryExists(ParamStr(2)){ and not CreateDirectory(pchar(ParamStr(2))) }then
begin
writeln('Destination directory ',ParamStr(2),' is not a valid path!');
Halt;
end;

// check out
checkouter(ParamStr(1),ParamStr(2));


//DeleteFile
//removeDir
//rmDir
//DirectoryExists
//CreateDirectory
//FileAge 函数 返回文件已存在的时间
//FileGetDate 函数 返回文件的DOS日期时间标记
//FileSize 函数 返回当前文件的大小
{
GetFileAttributes 返回文件属性
GetFileInformationByHandle 返回文件信息
GetFileSecurity 获取文件或目录安全信息
GetFileSize 返回指定文件大小
GetFileTime 返回文件64位时间
GetFileTitle 返回文件名
GetFileType 返回文件类型
GetFileVersionInfo 返回文件的版本信息
GetFileVersionInfoSize 返回可用版本信息大小

}
Halt;
end.



有大侠如果能帮助完成,分可再开帖加,加几百都不成问题. 多谢了.

[leoliangyong]

帮你UP

[episome]

这么没人帮我啊,唉.
很简单的问题啊, 我就是不知道象CreateDirectory这样的api,后面的一些乱七八糟的参数怎么写,麻烦的很那.

[alinsoft]

建议楼主还是静下心来好好学学程序。
CSDN里大家也许会帮你解决一个实际的，或者说有针对性的问题，而不会帮你对给定的功能写一个程序。
自己不去试试写，又怎么会知道自己行不行呢？
哈哈，变成教育的口吻了，楼主莫怪。

[zwb666]

ding

[hottey]

程序本身并不复杂啊，自己静下心来慢慢写啊！

[episome]

TO,alinsoft(艾林)
我不是做delphi的,具体的程序我知道该如何写.

也许我这么问的确不对,呵呵.好吧,我这么问.
GetFileSize ,GetFileTime,CreateDirectory这3个函数,后面的"乱七八糟"参数该如何加?

顺便问一下,类型转换的问题. 我就知道 pchar, 谁能告诉我其他的类型转换函数那里找? 都有那些?

真的多谢各位了.

[jl820712]

给你一个我写的代码吧，是按大小和文件的修改时间比较的，相同跳过不同则复制
有些地方还需要修改，你自己看看吧

unit Unit1;

interface

uses
Windows, SysUtils, ComCtrls, StdCtrls, ExtCtrls, Classes, Forms, Controls,
bsSkinCtrls, ShellAPI, Dialogs;
// Variants, Messages, Graphics

type
TRestore = class(TForm)
ProgressBar1: TProgressBar;
bsSkinPanel1: TbsSkinPanel;
bsSkinButton1: TbsSkinButton;
bsSkinButton2: TbsSkinButton;
bsSkinSpeedButton1: TbsSkinSpeedButton;
bsSkinSpeedButton2: TbsSkinSpeedButton;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Memo1: TMemo;
procedure bsSkinButton1Click(Sender: TObject);
procedure bsSkinButton2Click(Sender: TObject);
procedure bsSkinSpeedButton1Click(Sender: TObject);
procedure bsSkinSpeedButton2Click(Sender: TObject);
private
{ Private declarations }
public
function Restore(ftpads, copyads: string): Boolean;
{ Public declarations }
end;

var
Restore: TRestore;
Dir: integer;
Restoring: Boolean;

implementation

uses Unit2;

{$R *.dfm}

function TRestore.Restore(ftpads, copyads: string): Boolean;
var
i: Integer;
SubDir: TStringList;
SearchRec: TSearchRec;
PackSize, CurrentSize: Integer;
FromFile, ToFile: TFileStream;
CreateFT, LastAccessFT, LastWriteFT: TFileTime;

procedure Deletedir(Str: string);
var
T: TSHFileOpStruct;
begin
with T do
begin
Wnd := 0;
wFunc := FO_DELETE;
pFrom := PChar(Str);
pTo := nil;
fFlags := FOF_AllowUndo + FOF_NoConfirmation + FOF_NoErrorUI;
hNameMappings := nil;
lpszProgressTitle := '正在删除文件夹';
fAnyOperationsAborted := false;
end;
if SHFileOperation(T) <> 0 then
Memo1.Lines.Add('文件夹删除失败！')
else
Memo1.Lines.Add('文件夹删除成功！');
end;

function CheckDIR: Integer;
begin
if ((SearchRec.Attr and faDirectory <> 16) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
Result := 0//当前目录下的文件
else if ((SearchRec.Attr and faDirectory = 16) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
Result := 1//子目录
else
Result := 2;
end;

function CovFileDate(FileDate: _FileTime): TDateTime;
var
Tct: _SystemTime;
Temp: _FileTime;
begin
FileTimeToLocalFileTime(FileDate, Temp);
FileTimeToSystemTime(Temp, Tct);
CovFileDate := SystemTimeToDateTime(Tct);
end;

function CheckFile: Boolean;
var
FileInfo: TSearchRec;
begin
if FindFirst(copyads + SearchRec.Name, faAnyFile, FileInfo)=0 then
begin
if (SearchRec.Size = FileInfo.Size) and
(CovFileDate(SearchRec.FindData.ftLastWriteTime) = CovFileDate(FileInfo.FindData.ftLastWriteTime)) then
Result:= True
else
Result:= False;
end else
Result:= False;
FindClose(FileInfo);
end;

begin
if Restoring = false then
Result:=False
else
begin
if (FindFirst(copyads + '*.*', faAnyFile, SearchRec) = 0) and (Restoring=true) then
begin //删除多余文件夹
repeat
if (CheckDIR = 1) and (Restoring=true) and (not DirectoryExists(ftpads + SearchRec.Name)) then
begin
try
Memo1.Lines.Add('正在删除多余文件夹: ' + copyads + SearchRec.Name + ' 请稍候！');
Deletedir(copyads + SearchRec.Name);
except
// MessageDlg('删除文件夹失败！',mtError, [mbOk], 0);
end;
end;
Application.ProcessMessages;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
if (FindFirst(copyads + '*.*', faAnyFile, SearchRec) = 0) and (Restoring=true) then
begin //删除多余文件
repeat
if (CheckDIR = 0) and (Restoring=true) and (not FileExists(ftpads + SearchRec.Name)) then
begin
try
Memo1.Lines.Add('正在删除多余文件: ' + copyads + SearchRec.Name + ' 请稍候！');
FileSetAttr(copyads + SearchRec.Name, 0);
if DeleteFile(copyads + SearchRec.Name) then
Memo1.Lines.Add('文件删除成功！')
else
Memo1.Lines.Add('文件删除失败！');
except
// MessageDlg('删除文件失败！',mtError, [mbOk], 0);
end;
end;
Application.ProcessMessages;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
if (FindFirst(ftpads + '*.*', faAnyFile, SearchRec) = 0) and (Restoring=true) then
begin
repeat
if CheckDIR = 0 then //是文件
begin
Memo1.Lines.Add('Check: ' + copyads + SearchRec.Name);
if (CheckFile = False) and (Restoring=true) then
begin
try
Memo1.Lines.Add('DownLoading: ' + ftpads + SearchRec.Name);
PackSize := 4096;
ProgressBar1.Max := SearchRec.Size div PackSize;
FromFile := TFileStream.Create(ftpads + SearchRec.Name, fmOpenRead);
try
ToFile := TFileStream.Create(copyads + SearchRec.Name, fmCreate);
try
CurrentSize := 0;
repeat
if SearchRec.Size - CurrentSize <= PackSize then
PackSize := SearchRec.Size - CurrentSize;
ToFile.CopyFrom(FromFile, PackSize);
Inc(CurrentSize, PackSize);
ProgressBar1.Position := ProgressBar1.Position + 1;
until CurrentSize >= SearchRec.Size;
GetFileTime(ToFile.Handle, @CreateFT, @LastAccessFT, @LastWriteFT);
if SetFileTime(ToFile.Handle, @CreateFT, @LastAccessFT, @SearchRec.FindData.ftLastWriteTime) then
Memo1.Lines.Add('文件修复成功！')
else
Memo1.Lines.Add('文件修复失败！');
finally
ToFile.Free;
end
finally
FromFile.Free;
end;
except
// MessageDlg('修复失败！',mtError, [mbOk], 0);
end;
end;
end;
Application.ProcessMessages;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
//子目录遍历
SubDir := TStringList.Create;
try
if (FindFirst(ftpads + '*.*', faAnyFile, SearchRec) = 0) and (Restoring=true) then
begin
repeat
if CheckDIR = 1 then
begin
SubDir.Add(SearchRec.Name);
if not DirectoryExists(copyads + SearchRec.Name + '\') then
ForceDirectories(copyads + SearchRec.Name + '\');
end;
application.ProcessMessages;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
//子目录循环
for i := 0 to SubDir.Count - 1 do
begin
Restore(ftpads + SubDIR.Strings[i] + '\', copyads + SubDir.Strings[i] + '\');
end;
finally
SubDir.Free;
end;
Result:=True;
end;
end;

[jl820712]

procedure TRestore.bsSkinButton1Click(Sender: TObject);
begin
if bsSkinButton1.Caption = '修 复' then
begin
Restoring := true;
Memo1.Lines.Clear;
bsSkinButton1.Caption := '停止修复';
bsSkinButton2.Enabled := false;
bsSkinSpeedButton1.Enabled := false;
bsSkinSpeedButton2.Enabled := false;
if (Edit1.Text='') or (Edit2.Text='') then
ShowMessage('请选择要修复的目录！')
else
if Edit1.Text=Edit2.Text then
ShowMessage('不能为同一个目录！')
else
if Restore(Edit1.Text,Edit2.Text)=True then
ShowMessage('修复完毕！')
else
ShowMessage('修复失败！');
end;
if bsSkinButton1.Caption = '停止修复' then
begin
Restoring := false;
bsSkinButton1.Caption := '修 复';
ProgressBar1.Position:=0;
bsSkinButton2.Enabled := true;
bsSkinSpeedButton1.Enabled := true;
bsSkinSpeedButton2.Enabled := true;
end;
end;

procedure TRestore.bsSkinButton2Click(Sender: TObject);
begin
halt;
end;

procedure TRestore.bsSkinSpeedButton1Click(Sender: TObject);
begin
Application.CreateForm(TSelectDir, SelectDir);
Dir:=1;
SelectDir.ShowModal;
end;

procedure TRestore.bsSkinSpeedButton2Click(Sender: TObject);
begin
Application.CreateForm(TSelectDir, SelectDir);
Dir:=2;
SelectDir.ShowModal;
end;

end.

[episome]

感谢大伙支持.小功告成了