delphi 局域网共享文件夹上传文件

unit u_lcopy;


interface


uses
  windows,Dialogs,Classes,SysUtils,IniFiles,UnitAES;


type
  TlocFileCopy = class
  private


    Fconnected: Boolean;


  public
    gserver: string;
    glocPath: string;
    guser: string;
    gpass: string;
    constructor create;
    destructor  destroy;
    procedure StartCopy;
    function gConnectServer: Boolean;
  end;


 var gfilelist: TStringList;
 const
  gaeskey = '~ 2016xxt ';


implementation


{ TlocFileCopy }


procedure LocCopyFiles(vpathfile: Pointer); stdcall;
var
  i: Integer;
  lname: AnsiString;
  lpath: PChar;
begin
  lpath := PChar(vpathfile);
  if Trim((lpath)) = '' then Exit;
   with gfilelist do
   begin
     if gfilelist = nil then Exit;
     for i := 0 to gfilelist.Count - 1 do
     begin
       lname := ExtractFileName(gfilelist.Strings[i]);
       if CopyFile(PChar(gfilelist.Strings[i]),PChar(lpath + '\' + formatdatetime('yyyymmdd',Now)+ '\' + lname),false) then
       begin
         DeleteFile(gfilelist.Strings[i]);
       end;
     end;
   end;
end;


function ListFiles(path: string): TStringList;
var
  SearchRec: TSearchRec;
  found: integer;
begin
  result := TStringList.Create;
  found := FindFirst(path + '\' + '*.*', faAnyFile, SearchRec);
  if not DirectoryExists(path) then
  begin
    Result.Clear;
    exit;
  end;
  while found = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') and (SearchRec.Attr <> faDirectory) then
    begin
      if ExtractFileExt(SearchRec.Name) = '.asf' then
        result.Add(path + '\' + SearchRec.Name);
    end
    else if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
    begin
      Result.AddStrings(ListFiles(path + '\' + SearchRec.Name));
    end;
    found := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;




function TlocFileCopy.gConnectServer: boolean;
var
    NetSource   :   TNetResource;
    dwResult:DWORD;
    lstr: AnsiString;
begin
    Result := false;
    Fconnected := False;
    with   NetSource   do
    begin
        dwType   :=   RESOURCETYPE_ANY;
        lpLocalName   :='';
        lpRemoteName:=PChar(glocpath);
        lpProvider     :='';
    end;
    dwResult:=WnetAddConnection2(NetSource,PChar(gpass),PChar(guser),CONNECT_UPDATE_PROFILE);
    if dwResult<>0 then
    begin
        ShowMessage('连接服务器失败!');
        Exit;
    end
    else
    begin
      lstr := 'net use ' + glocPath + 'I$ ' +gpass + '/user:' + guser;
      if winexec(PAnsiChar(lstr),SW_HIDE)>31 then
      begin
        Sleep (3000);
        lstr := glocPath +'\' + FormatDateTime('yyyymmdd',Now);
        CreateDir(lstr);
      end
      else
      begin
          exit;
      end;
      Result := True;
      Fconnected := Result;
    end;
end;












constructor TlocFileCopy.create;
var
  lini: TIniFile;
  linifile: ansistring;
  lfilepath: ansistring;
  laes: TAes;
begin
  linifile :=  ExtractFileDir(ParamStr(0)) + '\CCTVView.ini';
  lfilepath :=  ExtractFileDir(ParamStr(0)) + '\videos\';
  lini := TIniFile.Create(linifile);
  laes := TAes.Create;
  glocPath := laes.DecryptString(lini.readstring('FILESERVER','Server',''),gaeskey);
  guser := laes.DecryptString(lini.readstring('FILESERVER','user',''),gaeskey);
  gpass := laes.DecryptString(lini.readstring('FILESERVER','pass',''),gaeskey);
  gfilelist := TStringList.Create;
  gfilelist := listfiles(lfilepath);
  FreeAndNil(lini);
  FreeAndNil(laes);


end;


destructor TlocFileCopy.destroy;
begin
  FreeAndNil(gfilelist);
end;


procedure TlocFileCopy.StartCopy;
var
  id,lh: DWORD;
  lpath: pchar;
begin
  if Fconnected then
  begin
  lpath := StrNew(PChar(glocPath));
  lh := CreateThread(nil,1000,@LocCopyFiles,lpath,0,id);
  end;
end;


end.