Советы по Delphi. Версия 1.4.3 от 1.1.2001 - Валентин Озеров

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;

Разное 

`Устойчивые` всплывающие подсказки