function CopyFile(InFile, OutFile: String; From, Count: Longint): Longint;
var InFS, OutFS: TFileStream;
begin
InFS := TFileStream.Create(InFile, fmOpenRead);
OutFS := TFileStream.Create(OutFile, fmCreate);
InFS.Seek(From, soFromBeginning);
Result := OutFS.CopyFrom(InFS, Count);
InFS.Free;
OutFS.Free;
end;
try..except расставляются по вкусу, а навороты вроде установки атрибутов, даты и времени файла и т.п. для ясности удалены, да и не нужны они в основном никогда.
Конечно, под Win32 имеет смысл использовать функции CopyFile, SHFileOperation.
Как получить имя папки pабочего стола (не чеpез registry)?
Nomadic советует:
Просто очень хочется поработать с shell functions.
В этом примере делается и это -
procedure TForm1.Button1Click(Sender: TObject);
procedure madd(s:string);
begin
memo1.lines.add(s);
end;
VAR
ppmalloc:imalloc;
id:ishellfolder;
pi:pitemidlist;
lpname:tstrret;
begin
if succeeded(shgetspecialfolderlocation(0, CSIDL_PROGRAMS, pi)) then begin
madd('Succeeded programs location');
if succeeded(shgetdesktopfolder(id)) then begin
madd('Succeeded get desktop folder');
if succeeded(id.getdisplaynameof(pi, 0, lpname)) then begin
madd('Succeeded get display name');
if lpname.uType=2 then begin
madd(lpname.cstr);
end;
end else madd('UnSucceeded get display name');
end else madd('UnSucceeded get desktop folder');
end else madd('UNSucceeded programs location');
end;
Количество строк в текстовом файле
Если файлы не слишком велики, вы можете сделать так:
List := TStringList.Create;
try
List.LoadFromFile('C:FILE.TXT');
Gauge.MaxValue := List.Count;
finally
List.Free;
end;
Мы читаем в память весь текст, и кроме подсчета строк этот код ничего не делает. Другая идея заключается в использовании не счетчика строк, а счетчика байт. В самом начале вы запрашиваете размер файла (используя функцию Delphi FileSize), и в цикле проходите все байты, как вы делали это со строками. Цикл может выглядеть примерно так (предположим, вы используете стандартный паскалевский тип TEXT):
Gauge.MaxValue := FileSize(TextFile);
Reset(TextFile);
while not eof(TextFile) do begin
Readln(TextFile, Line);
{ Обработка строки }
with Gauge do begin
Progress := Progress + Length(Line) + 2; { 2 для CR/LF }
Refresh;
end;
end;
Копирование файлов IV
Igor Nikolaev aKa The Sprite советует:
Copyfile('C:1.txt', 'C:files2.txt', 0);
где первый параметр – путь и имя нужного файла, а второй путь и имя нового(скопированого) файла
Если же необходимо задавать имена файлов через Edit, то:
Copyfile(PChar(edit1.text), PChar(edit2.text), 0);
Сеть
Как узнать доступные сетевые pесуpсы?
Nomadic советует:
Вот пример:
type
PNetResourceArray = ^TNetResourceArray;
TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;
Procedure EnumResources(LpNR:PNetResource);
Var
NetHandle: THandle;
BufSize: Integer;
Size: Integer;
NetResources: PNetResourceArray;
Count: Integer;
NetResult:Integer;
I: Integer;
NewItem:TListItem;
Begin
If WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
// RESOURCETYPE_ANY - все ресурсы
// RESOURCETYPE_DISK - диски
// RESOURCETYPE_PRINT - принтеры
0, LpNR, NetHandle) <> NO_ERROR then Exit;
Try
BufSize := 50 * SizeOf(TNetResource);
GetMem(NetResources, BufSize);
Try
while True do begin
Count := -1;
Size := BufSize;
NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
If NetResult = ERROR_MORE_DATA then begin
BufSize := Size;
ReallocMem(NetResources, BufSize);
Continue;
end;
if NetResult <> NO_ERROR then Exit;
For I := 0 to Count-1 do Begin
With NetResources^[I] do Begin
If RESOURCEUSAGE_CONTAINER = (DwUsage and RESOURCEUSAGE_CONTAINER) then
EnumResources(@NetResources^[I]);
If dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then
// ^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс
// RESOURCEDISPLAYTYPE_SERVER - компьютер
// RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа
// RESOURCEDISPLAYTYPE_GENERIC - сеть
Begin
NewItem:= Form1.ListView1.Items.Add;
NewItem.Caption:=LpRemoteName;
End;
End;
End;
End;
finally
FreeMem(NetResources, BufSize);
end;
finally
WNetCloseEnum(NetHandle);
end;
End;
procedure TForm1.Button1Click(Sender: TObject);
Var OldCursor: TCursor;
begin
OldCursor:= Screen.Cursor;
Screen.Cursor:= crHourGlass;
With ListView1.Items do Begin
BeginUpdate;
Clear;
EnumResource(nil);
EndUpdate;
End;
Screen.Cursor:= OldCursor;
end;
Реестр
Как из программы выявить версию Windows, на кого зарегистрирована и т.п.?
Nomadic пишет:
Вот тебе кyсочек Windows Registry, pазбиpайся:
=== Cut here! [a.reg] === REGEDIT4
[HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindowsCurrentVersion]
"InstallType"=hex:03,00
"SetupFlags"=hex:08,01,00,00
"DevicePath"="C:\WINDOWS\INF"
"ProductType"="9"
"RegisteredOwner"="Jacky Shikerya"
"RegisteredOrganization"="SigmaЩ Soft. Universal ltd.й"
"ProductId"="12095-OEM-0004226-12233"
"LicensingInfo"=""
"SubVersionNumber"=" B"
"InventoryPath"="C:\WINDOWS\SYSTEM\PRODINV.DLL"
"ProgramFilesDir"="C:\Program Files"
"CommonFilesDir"="C:\Program Files\Common Files"
"MediaPath"="C:\WINDOWS\media"
"ConfigPath"="C:\WINDOWS\config"
"SystemRoot"="C:\WINDOWS"
"OldWinDir"=""
"ProductName"="Microsoft Windows 95"
"FirstInstallDateTime"=hex:81,73,b0,22
"Version"="Windows 95"
"VersionNumber"="4.00.1111"
"BootCount"="3"
"OtherDevicePath"="C:\WINDOWS\INF\OTHER"
=== And cut Here!(or there?!) [a.reg] ===
В uses пpописываешь модуль Registry и дальше так:
var
R:TRegistry;
No:String;
begin
R:=TRegistry.Create;
R.RootKey:=HKEY_LOCAL_MACHINE;
R.OpenKey('….', false) {если false то пытается откpыть не создавая}
No:=R.ReadString('VersionNumber');
if no=….. then …… else ……
end;
Выше был приведён кусочек из Windows 95/98 Registry. В Windows NT эта ветвь находится в разделе [HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersion] Кроме того, обязательно посмотрите на список функций WinAPI, имена которых начинаются с Get…. Например, GetComputerName, GetVersionEx, GetSystemInfo, SystemParametersInfo.
Ярлыки (ShortCuts)
Создание ярлыков
[email protected] пишет:
Может ещё так можно ярлыки делать?
uses … ShlObj, ComObj, ActiveX, shellapi, ComCtrls, ... // не помню какая из них нужна, вообще наити можно поиском в *.pas в каталоге
// disk:Program FilesBorlandDelphi5Source
procedure SetShortCut(path, cmd, icon, wd, name, arg : String);
var
ShellObject:IUnknown;
LinkFile:IPersistFile;
ShellLink:IShellLink;
begin
Try
CoInitialize(nil);
ShellObject:=CreateComObject(CLSID_ShellLink);
LinkFile:=ShellObject as IPersistFile;
ShellLink:=ShellObject as IShellLink; // RTFM - интерфейсу IShellLink, там всё описано
ShellLink.SetPath(@cmd[1]);
ShellLink.SetWorkingDirectory(@wd[1]);
ShellLink.SetIconLocation(@icon[1], 0); // вместо 0 можно указать номер иконки если их там много…
ShellLink.SetDescription(@name[1]);
ShellLink.SetArguments(@arg[1]);
LinkFile.Save(PWChar(WideString(path)),true);
finally
ShellObject:=Unassigned;
CoUninitialize;
end;
end;
Разное
`Устойчивые` всплывающие подсказки
