Меню сайта
Копилка для дальнейшего развития ресурса.
Статистика
Онлайн всего: 1 Гостей: 1 Пользователей: 0
|
Программирование
Procedure TFrameRuleEngine.SaveRules; Var i: Integer; begin i := 0; While i < CheckListBoxRule.Items.Count Do Begin If CheckListBoxRule.Items[i] = '' Then Begin // Если ячейка пустая, то удаляем её CheckListBoxRule.Items.Delete(i); End Else Begin // Добавляем 1 или 0 соответственно checked или not checked CheckListBoxRule.Items[i] := IntToStr(Integer(CheckListBoxRule.Checked[i])) + CheckListBoxRule.Items[i]; Inc(i); End; End; // Сохраняем весь список CheckListBoxRule.Items.SaveToFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); end; Procedure TFrameRuleEngine.LoadRules; Var sChecked: String; i: Integer;
begin If FileExists(ExtractFilePath(Application.ExeName) + 'Rule.Txt') Then Begin // Считываем файл CheckListBoxRule.Items.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); i := 0; While i < CheckListBoxRule.Items.Count Do Begin If CheckListBoxRule.Items[i] = '' Then Begin // Удаляем пустую ячейку CheckListBoxRule.Items.Delete(i); End Else Begin // получаем состояние чекбокса sChecked := Copy(CheckListBoxRule.Items[i], 1, 1); CheckListBoxRule.Items[i] := Copy(CheckListBoxRule.Items[i], 2, Length(CheckListBoxRule.Items[i])); // Обновляем свойство Checked CheckListBoxRule.Checked[i] := Boolean(StrToInt(sChecked)); Inc(i); End; End; End; end;
|
function TForm1.DeleteDir(Dir: string): boolean;
var isFound: boolean; sRec: TSearchRec; begin Result := false; ChDir( Dir ); if IOResult <> 0 then begin ShowMessage( 'Не могу войти в каталог: ' + Dir ); Exit; end; isFound := FindFirst( '*.*', faAnyFile, sRec ) = 0; while isFound do begin if ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) then if ( sRec.Attr and faDirectory ) = faDirectory then begin if not DeleteDir( sRec.Name ) then Exit; end else if not DeleteFile( sRec.Name ) then begin ShowMessage( 'Не могу удалить файл: ' + sRec.Name ); Exit; end; isFound := FindNext( sRec ) = 0; end; FindClose( sRec ); ChDir( '..' ); RmDir( Dir ); Result := IOResult = 0; end;
|
// Способ первый procedure TForm1.CopyFiles(FromCopy, ToCopy: string); procedure FCopy( Path: string ); var sRec: TSearchRec; isFound: boolean; tempPath: string; begin if not DirectoryExists( ToCopy ) then CreateDir( ToCopy ); tempPath := ToCopy; isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0; while isFound do begin if ( ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) ) and ( ( sRec.Attr and faDirectory ) = faDirectory ) then begin tempPath := Path + '\' + sRec.Name; Delete( tempPath, 1, Length( FromCopy ) ); tempPath := ToCopy + tempPath; if not DirectoryExists( tempPath ) then CreateDir( tempPath ); FCopy( Path + '\' + sRec.Name ); Application.ProcessMessages; end else begin tempPath := Path + '\' + sRec.Name; Delete( tempPath, 1, Length( FromCopy ) ); tempPath := ToCopy + tempPath; CopyFile( PChar( Path + '\' + sRec.Name ), PChar( tempPath ), false ); ProgressBar1.Position := ProgressBar1.Position + sRec.Size; Application.ProcessMessages; end; isFound := FindNext( sRec ) = 0; Application.ProcessMessages; end; FindClose( sRec ); end; begin FCopy( FromCopy ); end;
procedure TForm1.Button1Click(Sender: TObject); begin CopyFiles( 'c:\откуда', 'd:\куда' ); end;
// Способ второй uses ..., ShellAPI;
function CopyDir( const fromDir, toDir: string ): boolean; var fos: TSHFileOpStruct; begin ZeroMemory( @fos, SizeOf( fos ) ); with fos do begin wFunc := FO_COPY; fFlags := FOF_FILESONLY; pFrom := PChar( fromDir + #0 ); pTo := PChar( toDir ) end; Result := ( 0 = ShFileOperation( fos ) ); end;
procedure TForm1.Button1Click(Sender: TObject); var i: integer; List: TStringList; begin List := TStringList.Create; List.Add( 'Путь к каталогу, который нужно скопировать' ); for i := 0 to List.Count-1 do if CopyDir( List.Strings[i], 'C:\' ) then ShowMessage( 'файлы скопированы' ); List.Free; end;
|
function GetAttribut( Path: string ): string;
var Atr: Integer; begin Result := '----'; Atr := FileGetAttr( Path ); if ( Atr and faReadOnly ) = faReadOnly then Result[1] := 'r'; if ( Atr and faHidden ) = faHidden then Result[2] := 'h'; if ( Atr and faSysFile ) = faSysFile then Result[3] := 's'; if ( Atr and faArchive ) = faArchive then Result[4] := 'a'; end;
|
|