Как убрать заголовок в дочерней форме MDI?

Если в дочерней форме MDI установить BorderStyle в bsNone, то заголовок формы не исчезнет. (Об этом сказано в хелпе). А вот следующий пример решает эту проблему:

type
... = class(TForm)
{ other stuff above }
    procedure CreateParams(var Params: TCreateParams); override;
{ other stuff below }
  end;

  ...

procedure tMdiChildForm.CreateParams(var Params: tCreateParams);

begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and (not WS_CAPTION);
end;

Взято с Исходников.ru

type
  TForm2 = class(TForm)
    { другой код выше }
    procedure CreateParams(var Params: TCreateParams); override;
    { другой код ниже }
  end;

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WS_OVERLAPPEDWINDOW or WS_BORDER
end;

Взято с

Как удалить данные из BLOB-поля?

Только с использованием SQL

UPDATE MyTable
Set MyBlobField = Null
WHERE SomeField = 'Somevalue'

Автор ответа Vit
Взято с Vingrad.ru

Как удалить файл из самого себя?

Очевидно что под Win32 удаление работающего кода невозможно. На время выполнения он просто добавляется к swap файлу - т.е. винды при нехватки памяти данные программы (массив переменных) сбрасывают в Swap (Page) файл, а сам код программы просто уничтожается из памяти, при возобновлении процесса, недостающие куски кода опять считываются из исходного файла. Понятно, что изменение файла пока его код выполняется будет иметь катастрофичные последствия, поэтому винды при запуске программы считают DLL или EXE файл по сути куском файла подкачки и запрещают любые манипуляции над ним. Кстати именно по этой причине все инсталляторы начинают свою работу с операции "Preparing to install", которая делает очень простую вещь - сам инсталлятор копируется во временную папку и перезапускает себя уже с винта, чтоб предотвратить крах системы при смене дискетты или CD. По этой же причине программы упакованные любыми EXE упаковщиками требуют больше памяти для запуска - так как загружается в память и исходный компрессированный код и декомпрессированный поток... Но несмотря на все сказанное можно удалить файл из "самого себя" при помощи маленькой хитрости: мы создаем и запускаем BAT файл - который и удалит программу, а саму программу закрываем, как только система "отпустит" файл - файл будет удален и затем BAT файл удалит самого себя. Пользователь всего этого не заметит - он увидит, что после завершении работы файла программы уже нет.

uses ShellApi;

procedure TForm1.FormDestroy(Sender: TObject);
var f: textFile;
  FileName: string;
begin
  FileName := changefileext(paramstr(0), '.bat');
  assignFile(f, FileName);
  rewrite(f);
  writeln(f, ':1');
  writeln(f, format('Erase "%s"', [paramstr(0)]));
  writeln(f, format('If exist "%s" Goto 1', [paramstr(0)]));
  writeln(f, format('Erase "%s"', [FileName]));
  closefile(f);
  ShellExecute(Handle, 'Open', PChar(FileName), nil, nil, sw_hide);
end;

Автор ответа: Vit
Взято с Vingrad.ru

Как удалить файл после перезагрузки Windows?

Я использую функцию, которая заносит в ключ реестра RunOnce командную строку:

command.com /c del C:\Путь\Имя_файла

Автор ответа: inko
Взято с Vingrad.ru

В wininit добавляешь строку NUL={ПУТЬ УДАЛЯЕМОГО ФАЙЛА}

Автор ответа: VoL
Взято с Vingrad.ru

Еще есть способ через реестр:

uses Registry;

procedure DeleteFileOnRestart (const FileName : String);
var Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  Reg.OpenKey ('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);
  Reg.WriteString ('Selfdel9x','command.com /C del "' + FileName + '"');
  Reg.WriteString ('SelfdelNT','cmd /C del "' + FileName + '"');
  Reg.CloseKey;
  Reg.Free;
end;

Тут две команды добавляются, т.к. на XP с command.com не рабоает...
Одна из них сработает, а другая пройдет в холостую...

Прислал p0s0l

Как удалить иконку с Tray?

Для удаления иконки вы должны знать ее ID и дескриптор окна-обработчика сообщений. Для удаления иконки с Tray надо вызвать функцию Shell_NotifyIcon() с параметром NIM_DELETE и указателем на экземпляр структуры NOTIFYICONDATA, у которого должны быть заполнены следующие поля: cbSize, hWnd, uID.

Взято из FAQ:

Как удалить одно значение из динамического массива?

type
  TArrayString = array of string;

procedure DeleteArrayIndex(var X: TArrayString; Index: Integer);
begin
  if Index > High(X) then Exit;
  if Index < Low(X) then Exit;
  if Index = High(X) then
  begin
    SetLength(X, Length(X) - 1);
    Exit;
  end;
  Finalize(X[Index]);
  System.Move(X[Index +1], X[Index],
  (Length(X) - Index -1) * SizeOf(string) + 1);
  SetLength(X, Length(X) - 1);
end;

// Example : Delete the second item from array a
// Beispiel : Losche das 2. Element vom array a

procedure TForm1.Button2Click(Sender: TObject);
var
  a: TArrayString;
begin
  DeleteArrayIndex(a, 2);
end;

Взято с сайта

Как удалить строку в StringGrid в run-time?

Можно сделать наследника от TCustomGrid. А у последнего есть метод - DeleteRow.

Автор ответа: Song
Взято с Vingrad.ru

Например удаление текущей строки:

Type TFakeGrid=class(TCustomGrid);

procedure TForm1.MyDelete(Sender: TObject);
begin
TFakeGrid(Grid).DeleteRow(Grid.row);
end;

Автор ответа: Vit
Взято с Vingrad.ru

Как удалить таблицу?

I've been doing extensive work with Client/Server Delphi and MS SQL Server as my back-end database. The operational model that I use for my Client/Server is that the client application acts only as local interface, and that all queries and calculations - even temporary files - are performed or created on the server. Now this presents a couple of problems in that garbage cleanup isn't quite as easy as it is when using local tables as temporary files.

For instance, a lot of my programs create temporary files that I either reference later in the program or that I use as temporary storage for outer joins. Once I'm done with them, I need to delete them. With local tables, it's a snap. Just get a list of the tables, and with a little bit of code that uses some Windows API calls, delete them. Not so easy with SQL Server tables. The reason why is that you have to go through the BDE to accomplish the task - something that's not necessarily very intuitive. Luckily, however, it doesn't involve low-level BDE API calls.

Below is a procedure listing that drops tables from any SQL Server database. After the listing I'll discuss particulars...

Parameter Descriptions

//varSes : TSession;         //A valid, open session
//DBName : String;            //Name of the SQL Server DB
//ArTables : array of String; //An array of table names
//StatMsg : TStatusMsg);      //A status message callback
                             //procedure

TStatusMsg is a procedural type used as a callback procedure

type
  TStatusMsg = procedure(Msg: string);

procedure DropMSSQLTempTables(var Ses: TSession;
  DBName: string;
  ArTables: array of string;
  StatMsg: TStatusMsg);
var
  N: Integer;
  qry: TQuery;
  lst: TStringList;
begin
  lst := TStringList.Create;

  Ses.GetTableNames(DBName, '', False, False, lst);

  try
    for N := Low(arTables) to High(arTables) do
      if (lst.IndexOf(ArTables[N]) > 0) then
      begin
        StatMsg('Removing ' + arTables[N] +
          ' from client database');
        qry := TQuery.Create(nil);
        with qry do
        begin
          Active := False;
          SessionName := Ses.SessionName;
          DatabaseName := DBName;
          SQL.Add('DROP TABLE ' + arTables[N]);
          try
            ExecSQL;
          finally
            Free;
            qry := nil;
          end;
        end;
      end;
  finally
    lst.Free;
  end; { try/finally }
end;

The pseudo-code for this is pretty easy.

1.1.   Get a listing of all tables in the SQL Server database passed to the procedure.
2.2.   Get a table name from the table name array.
3.3.   If a passed table name happens to be in the list of table retrieved from the database, DROP it.
4.4.   Repeat 2. and 3. until all table names have been exhausted.

The reason why I do the comparison in step 3 is because if you issue a DROP query against a non-existent table, SQL Server will issue an exception. This methodology avoids that issue entirely.

Below is a detailed description of the parameters.

Ses   var TSession   This is a session instance variable that you pass by reference into the procedure. Note: It MUST be instantiated prior to use. The procedure does not create an instance. It assumes it already exists. This is especially necessary when using this procedure within a thread. But if you're not creating a multi- threaded application, then you can use the default Session variable.

DBName   String   Name of the MS SQL Server client database

ArTables

Array of String This is an open array of string that you can pass into the procedure. This means that you can pass any size array and the procedure will handle it. For instance, in the Primary table maker program, I define an array as follows:
arPat[0] := 'dbo.Temp0';
arPat[1] := 'dbo.Temp1';
arPat[2] := 'dbo.Temp2';
arPat[3] := 'dbo.Temp3';
arPat[4] := 'dbo.Temp4';
arPat[5] := 'dbo.Temp5';
arPat[6] := 'dbo.PatList';
arPat[7] := 'dbo.PatientList';
arPat[8] := 'dbo.EpiList';
arPat[9] := 'dbo.' + FDisease + 'CrossTbl_' + FQtrYr;
arPat[10] := 'dbo.' + FDisease + 'Primary_' + FQtrYr;

and pass it into the procedure.

StatMsg

TStatusMsg   This is a procedural type of : procedure(Msg : String). You can't use a class method for this procedure; instead, you declare a regular procedure that references a regular procedure. For example, I declare an interface-level procedure called StatMsg that references a thread instance variable and a method as follows:

procedure StatMsg(Msg: string);
begin
thr.FStatMsg := Msg;
thr.Synchronize(thr.UpdateStatus);
end;

The trick here is that "thr" is the instance variable used to instantiate my thread class. The instance variable resides in the main form of my application. This means that it too must be declared as an interface variable.

I'm usually averse to using global variables and procedures. It's against structured programming conventions. However, what this procedure buys me is the ability to place it in a centralized library and utilize it in all my programs.

Before you use this, please make sure you review the table above. You need to declare a type of TStatusMsg prior to declaring the procedure. If you don't, you'll get a compilation error.

Взято с

Delphi Knowledge Base

Как удалить вертикальную полосу прокрутки (скроллбар) из DBGrid?

Для этого необходимо переопределить метод Paint. Внутри метода Paint Вы должны вызвать API процедуру SetScrollRange для установки минимального и максимального значений скроллирования в ноль (тем самым запретив скроллбар), а затем вызвать inherited. Следующий код, это unit содержащий новый компонент под названием TNoScrollBarDBGrid, который делает это.

type
  TNoScrollBarDBGrid = class(TDBGrid)
  private
  protected
    procedure Paint; override;
  public
  published
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TNoScrollBarDBGrid]);
end;

{ TNoScrollBarDBGrid }

procedure TNoScrollBarDBGrid.Paint;
begin
  SetScrollRange(Handle, SB_VERT, 0, 0, false);
  inherited;
end;

Взято с Исходников.ru

Как удалить/восстановить файлы из корзины?

programdel;

uses
  ShellApi;

//function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall;

var
  T: TSHFileOpStruct;
  P: string;
begin
  P := 'C:\Windows\System\EL_CONTROL.CPL';
  with T do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := Pchar(P);
    fFlags := FOF_ALLOWUNDO
  end;
  SHFileOperation(T);
end.

Восстановление

Есть некоторые причуды, и Вы должны помнить о следующем:

Дайте полный путь для каждого файла. Не доверяйте текущей директории, даже если Вы ее изменили непосредственно перед вызовом функции. Функция WinAPI SHFileOperation не достаточно "умная" для использования текущей директории при отсутствии информации о предыдущей директории (для осуществления функции восстановления). Так, даже если используете флаг FOF_ALLOWUNDO, это не восстановит удаленные файлы из корзины, поскольку функция ничего не знает о предыдущем месторасположении файлов, и, таким образом, не сможет их восстановить файлы из корзины в их оригинальное месторасположение. Она просто удалит файлы из текущей директории.
Microsoft скорректировала документацию о члене pFrom. Новая редакция сообщает о подробностях работы в пакетном режиме: необходимо разделить имя каждого файла символом NULL (#0) и добавить к концу списка двойной символ NULL. Терминатор из двух символов NULL необходим в любом случае: работаете вы с одним файлом, или же используете пакетный режим. Иногда это работает и без терминатора, но чаще нет. Это связано с тем, что функции при работе с памятью считывает данные из памяти, располагающейся до терминатора, а поскольку длина строки может не совпадать с распределенной памятью, то данные, находящиеся после терминатора, просто не обрабатываются.
Пример правильного кодирования:

var
  FileList: string;
  FOS: TShFileOpStruct;
begin
  FileList := 'c:\delete.me'#0'c:\windows\temp.$$$'#0#0;
  { если Вы используете имена файлов в строковых переменных: }
  FileList := Filename1 + #0 + Filename2 + #0#0;
  FOS.pFrom := PChar(FileList);
  // бла бла бла
end;

Взято с

Как удалить все файлы из Recent Documents List?

Для этого можно воспользоваться API функцией SHAddToRecentDocs:

procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, 0);
end;

Не забудьте включить ShlObj в Unit

Взято с Исходников.ru

Как удобнее работать с буфером обмена как последовательностью байт?

unitClipStrm;

{
  This unit is Copyright (c) Alexey Mahotkin 1997-1998
  and may be used freely for any purpose. Please mail
  your comments to
  E-Mail: alexm@hsys.msk.ru
  FidoNet: Alexey Mahotkin, 2:5020/433

  This unit was developed during incorporating of TP Lex/Yacc
  into my project. Please visit ftp://ftp.nf.ru/pub/alexm
  or FREQ FILES from 2:5020/433 or mail me to get hacked
  version of TP Lex/Yacc which works under Delphi 2.0+.
}

interface uses Classes, Windows;

type
  TClipboardStream = class(TStream)
  private
    FMemory : pointer;
    FSize : longint;
    FPosition : longint;
    FFormat : word;
  public
    constructor Create(fmt : word);
    destructor Destroy; override;

    function Read(var Buffer; Count : Longint) : Longint; override;
    function Write(const Buffer; Count : Longint) : Longint; override;
    function Seek(Offset : Longint; Origin : Word) : Longint; override;
  end;

implementation uses SysUtils;

constructor TClipboardStream.Create(fmt : word);

var
  tmp : pointer;
  FHandle : THandle;
begin
FFormat := fmt;
OpenClipboard(0);
FHandle := GetClipboardData(FFormat);
FSize := GlobalSize(FHandle);
FMemory := AllocMem(FSize);
tmp := GlobalLock(FHandle);
MoveMemory(FMemory, tmp, FSize);
GlobalUnlock(FHandle);
FPosition := 0;
CloseClipboard;
end;

destructor TClipboardStream.Destroy;
begin
FreeMem(FMemory);
end;

function TClipboardStream.Read(var Buffer; Count : longint) : longint;
begin
if FPosition + Count > FSize then
  Result := FSize - FPosition
else
  Result := Count;
MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);

Inc(FPosition, Result);
end;

function TClipboardStream.Write(const Buffer; Count : longint) : longint;
var
  FHandle : HGlobal;
  tmp : pointer;
begin
ReallocMem(FMemory, FPosition + Count);
MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);
FPosition := FPosition + Count;
FSize := FPosition;
FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);
try
  tmp := GlobalLock(FHandle);
  try
    MoveMemory(tmp, FMemory, FSize);
    OpenClipboard(0);
    SetClipboardData(FFormat, FHandle);
  finally
    GlobalUnlock(FHandle);

  end;
  CloseClipboard;
except
  GlobalFree(FHandle);
end;
Result := Count;
end;

function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;
begin
case Origin of
0 : FPosition := Offset;
1 : Inc(FPosition, Offset);
2 : FPosition := FSize + Offset;
end;
Result := FPosition;
end;

end.

Alexey Mahotkin alexm@hsys.msk.ru (2:5020/433)

Взято из

FAQ:
Delphi and Windows API Tips'n'Tricks
olmal@mail.ru
http://www.chat.ru/~olmal

Как указать максимальный размер текста для RichEdit Control?

У этого компонента есть свойство MaxLength, которое работает некорректно. Поэтому лучше пользоваться
RichEdit.Perform(EM_LIMITTEXT,нужный размер, 0);

Причем перед каждом открытии файла это действие необходимо повторять.

Maxim Liverovskiy
(2:5030/254.38)

Если Вы передаете в качестве размера 0, то ОС ограничивает размер OS Specific Default Value. Реально, по результатам моих экспериментов, поставить можно размер, чуть меньший доступной виртуальной памяти. Я ограничился 90% от свободной виртуалки.
Для того, чтобы не повторять этот вызов (EM_LIMITTEXT), можно воспользоваться сообщением EM_EXLIMITTEXT.

Stas Mehanoshin

Автор:

StayAtHome

Взято из

Как уменьшить дату в Paradox

В Local SQL для Paradox имеется ошибка, вместо вычитания происходит сложение даты с константой.

// Это добавляет единицу!
UPDATESAMPLE.DB SET DT = DT - 1

// а данное выражение даст правильный результат:
UPDATE SAMPLE.DB SET DT = DT + (-1)

Источник: http://www.delphifaq.com/fq/q0048.shtml

Взято из

Как упаковать таблицу?

usesBDE; // for D3, для D2 не помню (что-то типа DbiProcs и еще что-то)

// для пpимеpа
tLog: TTable; // таблица, юзающая d:\db\log.db

var
  TblDesc: CRTblDesc;
  rslt: DBIResult;
  Dir: string; //имеется в виду huge string т.е. {$H+}
  hDb: hDbiDb;

begin
  tLog.Active := False; //деактивиpуем TTable

  SetLength(Dir, dbiMaxNameLen + 1);
  DbiGetDirectory(tLog.DBHandle, False, PChar(Dir));
  SetLength(Dir, StrLen(PChar(Dir)));

  DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb);

  DbiSetDirectory(hDb, PChar(Dir));

  FillChar(TblDesc, sizeof(CRTblDesc), 0);
  StrPCopy(TblDesc.szTblName, 'd:\db\log.db');
  // здесь должно быть полное имя файла
  //котоpое можно: а) ввести pуками;
  //б) вытащить из пpопеpтей таблицы;
  //в) вытащить из алиаса;
  //г) см. FAQ
  StrCopy(TblDesc.szTblType, szParadox);
  //BTW тут может и szDBase стоять

  TblDesc.bPack := TRUE;

  DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False);
  DbiCloseDatabase(hDb);

end;

Автор: Pavel Kulchenko

Взято из

Как управлять сервисом на другом компьютере в W2K?

Требуется написать управление сервисом, запущеном на другом компьютере. С помошью чего это лучеше сделать?

uses
  Windows, Messages, SysUtils,
  StdCtrls, SvcMgr;
var
  ssStatus: TServiceStatus;
  schSCManager,
    schService: SC_HANDLE;

begin
  schSCManager := OpenSCManager(PChar('Comp1'), //имя компьютера, nil - local machine
    nil, // ServicesActive database
    SC_MANAGER_ALL_ACCESS); // full access rights

  if schSCManager = 0 then exit; //Ошибка?

  schService := OpenService(
    schSCManager, // SCM database
    PChar('SQLServerAgent'), // посмотри имя в Services. В данном случае - MS Server Agent
    SERVICE_ALL_ACCESS);

  if schService = 0 then exit; //Ошибка?

  if not QueryServiceStatus(
    schService, // handle to service
    ssStatus) then // address of status information structure
    exit; //Ошибка?

  case ssStatus.dwCurrentState of
    :
      SERVICE_RUNNING: ShowMessage('Работает!');
    SERVICE_STOPPED: ShowMessage('Выключен');
// ну и т.д.
  end;
end;

Взято с сайта

Как управлять спикером под 9х из Дельфи?

Прислал: Ненашев Илья Николаевич

Под WinNT/2000/XP вы можете использовать Beep(Tone, Duration) (задавать тон и продолжительность звучания). А под 9.x/Me эта функция не реализована, но можно командовать железом через порты, и сделать универсальную:

unit BeepUnit;

procedure Beep(Tone, Duration: Word); // универсальная - версию виндовса проверяет

procedure Sound(Freq : Word);
procedure NoSound;

procedure SetPort(address, Value:Word);
function GetPort(address:word):word;

implementation

procedure SetPort(address, Value:Word);
var
  bValue: byte;
begin
  bValue := trunc(Value and 255);
  asm
    mov dx, address
    mov al, bValue
    out dx, al
  end;
end;

function GetPort(address:word):word;
var
  bValue: byte;
begin
  asm
    mov dx, address
    in al, dx
    mov bValue, al
  end;
  GetPort := bValue;
end;

procedure Sound(Freq : Word);
var
  B : Byte;
begin
  if Freq > 18 then begin
    Freq := Word(1193181 div LongInt(Freq));
    B := Byte(GetPort($61));
    if (B and 3) = 0 then begin
      SetPort($61, Word(B or 3));
      SetPort($43, $B6);
    end;
    SetPort($42, Freq);
    SetPort($42, Freq shr 8);
  end;
end;

procedure NoSound;
var
  Value: Word;
begin
  Value := GetPort($61) and $FC;
  SetPort($61, Value);
end;

procedure Beep(Tone, Duration: Word);
begin
  if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT
    then Windows.Beep(Tone, Duration)
    else begin
      Sound(Tone);
      Windows.Sleep(Duration);
      NoSound;
    end;
end;

end.

Взято с Исходников.ru

Как установить BDE?

programInstallPrfSt;

{
Программа иллюстрирует, как установить BDE с поддержкой PARADOX 7.0
на "чистой машине" и создать алиас.
Пример использования в качестве простейшего инсталлятора для программы
C:\MyDir\MyProg.exe
1.Создайте каталог C:\MyDir\BDE и скопируйте в него след. файлы:
CHARSET.BLL
OTHER.BLL
IDAPI32.CFG
BLW32.DLL
IDAPI32.DLL
IDBAT32.DLL
IDPDX32.DLL
IDR20009.DLL
IDSQL32.DLL
BDEADMIN.EXE - по вкусу, т.к. необходимым не является.
2.Измените значение константы AliasName на имя необходимого вам алиаса.
3.Откомпиллируйте и запустите эту программу из каталога C:\MyDir.
ВHИМАHИЕ!!! Если на машине уже установлено BDE, то перед экспериментами
сохраните (на всякий случай) след. ключи из реестра:
[HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Database Engine] и
[HKEY_LOCAL_MACHINE\SOFTWARE\Borland\BLW32].
}

{$APPTYPE CONSOLE}
uses
  Windows, BDE, Registry;

const
  AliasName: string = 'PrefStat';

var
  R: DBIResult;
  Path: string;

procedure WriteString(S1:string);
begin
  S1 := S1 + #0;
  AnsiToOem(@S1[1], @S1[1]);
  writeln(S1);
end;

function GetExePath(S1:string):string;
var
  I, K :Integer;
  S: string;
begin
  K := 1;
  S := '';
  for I := Length(S1) downto 1 do
  begin
    if S1[I] = '\' then
    begin
      K := I;
      Break;
    end;
  end;

  for I := 1 to K - 1 do
    S := S + S1[I];

  Result:=S;
end;

procedure InstallBde;
const
  Bor: string = 'SOFTWARE\Borland';
var
  a: TRegistry;
  BPath: string;
begin
  BPath:=PATH + '\BDE';
  a := TRegistry.Create;
  with a do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(Bor + '\Database Engine', True);
    WriteString('CONFIGFILE01', BPath+'\IDAPI32.CFG');
    WriteString('DLLPATH', BPath);
    WriteString('RESOURCE', '0009');
    WriteString('SaveConfig', 'WIN32');
    WriteString('UseCount', '2');
    CloseKey;
    OpenKey(Bor+'\BLW32',True);
    WriteString('BLAPIPATH', BPath);
    WriteString('LOCALE_LIB3', BPath+'\OTHER.BLL');
    WriteString('LOCALE_LIB4', BPath+'\CHARSET.BLL');
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\SYSTEM\INIT',True);
    WriteString('AUTO ODBC', 'FALSE');
    WriteString('DATA REPOSITORY', '');
    WriteString('DEFAULT DRIVER', 'PARADOX');
    WriteString('LANGDRIVER', 'ancyrr');
    WriteString('LOCAL SHARE', 'FALSE');
    WriteString('LOW MEMORY USAGE LIMIT', '32');
    WriteString('MAXBUFSIZE', '2048');
    WriteString('MAXFILEHANDLES', '48');
    WriteString('MEMSIZE', '16');
    WriteString('MINBUFSIZE', '128');
    WriteString('SHAREDMEMLOCATION', '');
    WriteString('SHAREDMEMSIZE', '2048');
    WriteString('SQLQRYMODE', '');
    WriteString('SYSFLAGS', '0');
    WriteString('VERSION', '1.0');
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\SYSTEM\FORMATS\DATE',True);
    WriteString('FOURDIGITYEAR', 'TRUE');
    WriteString('LEADINGZEROD', 'FALSE');
    WriteString('LEADINGZEROM', 'FALSE');
    WriteString('MODE', '1');
    WriteString('SEPARATOR', '.');
    WriteString('YEARBIASED', 'TRUE');
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\SYSTEM\FORMATS\NUMBER',True);
    WriteString('DECIMALDIGITS', '2');
    WriteString('DECIMALSEPARATOR', ',');
    WriteString('LEADINGZERON', 'TRUE');
    WriteString('THOUSANDSEPARATOR', ' ');
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\SYSTEM\FORMATS\TIME',True);
    WriteString('AMSTRING', 'AM');
    WriteString('MILSECONDS', 'FALSE');
    WriteString('PMSTRING', 'PM');
    WriteString('SECONDS', 'TRUE');
    WriteString('TWELVEHOUR', 'TRUE');
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\REPOSITORIES',True);
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\DRIVERS\PARADOX\INIT',True);
    WriteString('LANGDRIVER', 'ancyrr');
    WriteString('TYPE', 'FILE');
    WriteString('VERSION', '1.0');
    CloseKey;
    OpenKey(Bor+'\Database Engine\Settings\DRIVERS\PARADOX\TABLE
    CREATE',True);
    WriteString('BLOCK SIZE', '4096');
    WriteString('FILL FACTOR', '95');
    WriteString('LEVEL', '7');
    WriteString('STRICTINTEGRTY', 'TRUE');
    CloseKey;
  end;
  a.Free;
end;

begin
  Path:=GetExePath(ParamStr(0));
  R:=dbiInit(nil);
  if R<>DBIERR_NONE then
  begin
    WriteString('Инициализация BDE ...');
    InstallBDE;
  end;
  R:=dbiInit(nil);
  if R=DBIERR_NONE then
  begin
    WriteString('Инициализация BDE прошла успешно');
    DbiDeleteAlias(nil, PChar(AliasName));
    R:=DbiAddAlias(nil, PChar(AliasName), szPARADOX,
    PChar('PATH:'+Path+'\DB'), True);
    if R=DBIERR_NONE then
      WriteString('Псевдоним "'+AliasName+'" создан')
    else
      WriteString('Ошибка создания псевдонима "'+AliasName+'"');
    R:=DbiCfgSave(nil, nil, Bool(-1));
    if R=DBIERR_NONE then
      WriteString('Файл конфигурации сохранён')
    else
      WriteString('Ошибка сохранения файла конфигурации');
    DbiExit;
  end
  else
    WriteString('Ошибка инициализации BDE');
end.

Взято с

Следуйте приведенной ниже инструкции для разворачивания BDE на клиентской машине:

1.Отформатируйте две дискеты в дисководе клиентской машины. Пометьте дискеты как "Disk 1" и "Disk 2".
2.Скопируйте файлы с DELPHI CD, содержащиеся в каталоге \REDIST\BDEINST\DISK1 на дискету, помеченную как "Disk 1", и файлы из каталога \REDIST\BDEINST\DISK2 на дискету "Disk 2".
3.Вставьте в дисковод клиентской машины дискету, помеченную как "BDE Install 1" (в нашем примере мы используем дисковод с буквой A:).
4.Убедитесь в том, что в Windows отсутствуют запущенные программы. В Windows Program Manager выберите File|Run, введите в поле редактирования командной строки ("Command Line") "A:\DISK1\SETUP" и нажмите "OK" для начала установки Borland Database Engine на клиентской машине.
5.Сначала, на короткое время, появится окно "Database Engine Install", затем диалог "preparing to install...", и, наконец, диалог "BDE Redisttributable", содержащий кнопки Continue (Продолжить) и Exit (Выйти). Нажмите "Continue".
6.Появится диалог "Borland Database Engine Location Settings", позволяющий изменить каталог установки программ BDE и конфигурационных файлов. Оставьте настройки по умолчанию и нажмите "Continue" (Продолжить).
7.Появится диалог "Borland Database Engine Installation", позволяющий вернуться к предыдущим диалогам или начать установку. Нажмите "Install" (Установить).
8.Процесс копирования дискеты "Disk 1" будет отображаться полоской прогресса.
9.Появится диалог "BDE Redistributable Install Request". Вставьте дискету "Disk 2". Нажмите "continue" (Продолжить).
10.По окончании процедуры установки появится диалог "Borland Database Engine Installation Notification", сообщающий об успешной установке BDE. Нажмите "Exit" (Выход).
11.Завершите работу Windows, удалите дискету из дисковода и перегрузите клиентскую машину.
12. Если настройки по умолчанию уже где-то используются, произойдут изменения, указанные ниже.
На клиентской машине появятся два новых каталога - \IDAPI и \IDAPI\LANGDRV. Обратите внимание на то, что утилита BDE Configuration Utility, BDECFG.EXE, располагается в каталоге \IDAPI. Языковые драйвера располагаются в каталоге \IDAPI\LANGDRV как файлы *.LD. AUTOEXEC.BAT, CONFIG.SYS и SYSTEM.INI при инсталляции не изменяются.

WIN.INI в каталоге \WINDOWS\SYSTEM будет иметь новые секции:

[IDAPI]
DLLPATH=C:\IDAPI
CONFIGFILE01=C:\IDAPI\IDAPI.CFG

[Borland Language Drivers]
LDPath=C:\IDAPI\LANGDRV

Взято из

Советов по Delphi от

Сборник Kuliba

Как установить BDE из файла BDEINST.CAB?

If you have taken a close look at the listing of the BDE installation directory (usually \Program Files\Borland\Common FIles\BDE), you've noticed there's a file called BDEINST.CAB. If BDEINST.CAB isn't present in the BDE folder, you probably chose not to let it be installed. As this tip requires this file, you might want to run install again and install only BDEINST.CAB. Anyway, let's get back to the tip.

What is BDEINST.CAB?

BDEINST.CAB is a cabinet (Microsoft's compression format) file that contains only one large file: BDEINST.DLL. This DLL contains a simple installation program along with all the necessary files for a basic install of BDE. It will correctly install BDE with the native drivers for Paradox, dBase, MS Access and FoxPro. It won't install drivers for SQL database servers. If all you need is a basic installation of BDE for supporting one of the forementioned databases, then BDEINST.CAB is the best choice for you.

Given the problem InstallShield and Wise have with installing BDE 5, BDEINST.DLL has a great appeal, since it was created by the Borland folks and doesn't suffer from the same problems InstallShield and WISE do.

There is, however, a drawback: BDEINST.DLL is a quite large file, so it's that good if you're deploying on floppy disks. There's a workaround for this problem and we'll get back to it later on.

Using BDEINST.DLL

In order to use BDEINST.DLL, all you have to do is to extract it from BDEINST.CAB. There are several ways this can be done. Two of them are:

·Using WinZip or another CAB-compatible archiver. Simply extract BDEINST.DLL from the CAB file.
·Using Microsoft's EXTRACT utility that comes with Windows 9x and NT. From a DOS window, issue the command below (path is also shown):
·
·C:\Program Files\Borland\Common Files\BDE>EXTRACT /E BDEINST.CAB
·
·This will extract BDEINST.DLL to the current directory, since no destination dir was specified in the command line.

The task now is to use the DLL. This is as simple as issuing the command line below:

C:\WINDOWS\SYSTEM\REGSVR32.EXE /S CABINST.DLL

If the command above fails, make sure you have REGSVR32.EXE on your machine. Not all machines have it, and, in case of deploying BDEINST.DLL, it's also a good idea to deploy REGSVR32.EXE. This file can be found in \WINDOWS\SYSTEM or \WINNT\SYSTEM32.

A progress dialog box will popup indicating that the installation of BDE is going ok. This is all it takes to install BDE without needing any additional tool such as InstallShield or Wise.

If you do not want to deploy REGSVR32.EXE, you can create a small VCL-less and formless application that simply calls DllRegisterServer from the DLL.

Взято с

Delphi Knowledge Base

Problem/Question/Abstract:

What are the essential files to ship with an application that uses the BDE?

Answer:

Delphi allows you to generate a nice tight executable file (.EXE), but if you have created a database application you must include the files that make up the Borland Database Engine as well. The table below shows the files that are mandatory when delivering a database application with Delphi.
File NameDescription
IDAPI01.DLL - BDE API DLL
IDBAT01.DLL - BDE Batch Utilities DLL
IDQRY01.DLL - BDE Query DLL
IDASCI01.DLL - BDE ASCII Driver DLL
IDPDX01.DLL - BDE Paradox Driver DLL
IDDBAS01.DLL - BDE dBASE Driver DLL
IDR10009.DLL - BDE Resources DLL
ILD01.DLL - Language Driver DLL
IDODBC01.DLL - BDE ODBC Socket DLL
ODBC.New - Microsoft ODBC Driver Manager DLL V2.0
ODBCINST.NEW - Microsoft ODBC Driver Installation DLL V2.0
TUTILITY.DLL - BDE Table Repair Utility DLL
BDECFG.EXE - BDE Configuration Utility DLL
BDECFG.HLP - BDE Configuration Utility Help
IDAPI.CFG - BDE Configuation File (settings)

To assist the user, Delphi ships with an install program for exporting the appropriate files that you want deliver to your clients. Also, installation programs such as InnoSetup and InstallShield can automatically include the relevant files in their setup programs.

InnoSetup is my program installation program of choice, and it is FREE! For more information or to download a copy visit Jordan Russell's site at

Finally a tip on using the setup CAB file that ships with the BDE to install the relevant files can be found in DKB, article title "Installing BDE from BDEINST.CAB"

Взято с

Delphi Kno

wledge Base

Как установить цвет фона иконок на рабочем столе, либо сделать у них прозрачный фон?

Для этого нужно найти окно "SysListView32" (которое является списком, который содержит иконки рабочего стола). Сперва будем искать главное родительское окно "Progman", которое содержит дочернее окно "SHELLDLL_DefView" , которое в свою очередь имеет дочернее окно "SysListView32". Для этого можно воспользоваться API функцией FindWindow to. Когда Мы получим дескриптор окна "SysListView32", то можно будет воспользоваться макросами ListView_SetTextBkColor и ListView_SetTextColor для установки желаемого цвета.

Ниже приведена процедура, которая делает всё вышеперечисленное. Если параметр Trans равен true, то будет установлен прозрачный фон, иначе цвет фона будет равен Background.

unit DeskIcons;

interface
uses Graphics; // Будет использоваться TColor

procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);
procedure SetDefaultIconColors;

implementation
uses Windows, CommCtrl; // будут использоваться HWND и ListView_XXXXX

procedure SetDesktopIconColor(Forground, Background: TColor; Trans: Boolean);

var
  Window: HWND;
begin
  // Находим нужное окно в три этапа
  Window := FindWindow('Progman', 'Program Manager');
  // Используем FindWindowEx для нахождения дочернего окна
  Window := FindWindowEx(Window, HWND(nil), 'SHELLDLL_DefView', '');
  // SysListView32, это список с иконками на рабочем столе
  Window := FindWindowEx(Window, HWND(nil), 'SysListView32', '');
  // Используем макрос для очистки цвета фона
  if Trans then
    ListView_SetTextBkColor(Window, $ffffffff) // фоновый цвет
  else
    ListView_SetTextBkColor(Window, Background); // фоновый цвет
  ListView_SetTextColor(Window, Forground); // передний цвет
  // теперь перерисовываем иконки
  ListView_RedrawItems(Window, 0, ListView_GetItemCount(Window) - 1);
  UpdateWindow(Window);   // даём команду "немедленно перерисовать"
end;

procedure SetDefaultIconColors;
{ Эта процедура устанавливает цвета, которые заданы в
  windows по умолчанию }
var
  Kind: Integer;
  Color: TColor;
begin
  Kind := COLOR_DESKTOP;
  Color := GetSysColor(COLOR_DESKTOP);
  SetSysColors(1, Kind, Color);
end;

end.

Взято с Исходников.ru

Как установить клиента InterBase

1. Для Yaffil или FireBird последних билдов - ничего не надо, кроме gds32.dll в директориях поиска библиотек.

2. Для IB5, IB6 или старого FB первых билдов - надо дополнительно прописать в файле services строчку "gds_db 3050/tcp" {файл должен завершаться пустую строкой}.

3. Для IB5, дополнительно к п.2., добавить в ключ реестра:

HKLM\SOFTWARE\InterBase Corp\InterBase\CurrentVersion\RootDirectory

строковое значение - имя папки, в которой лежит файл ib_license.dat

4. В случае медленного подключения клиентов в сети TCP/IP попробуйте прописать адреса IB серверов в файле HOSTS.

Взято из

Как установить минимальный размер окна?

Необходимо объявить обработчик события для WM_GETMINMAXINFO:

...
private
  procedure WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
  message WM_GETMINMAXINFO;

А вот как выглядит сам обработчик:

procedure TForm1.WMGetMinMaxInfo(var Message : TWMGetMinMaxInfo);
begin
  Message.MinMaxInfo^.ptMinTrackSize := Point(Width, Height);
  Message.MinMaxInfo^.ptMaxTrackSize := Point(Width, Height);
end;

Взято с Исходников.ru

Примечание от Vit:

Начиная с Дельфи 5 появилось удобное свойство Constrains - специально для ограничесния минимальных и максимальных размеров...

Как установить обои в формате jpeg?

Как установить обои в формате jpeg.
SystemParametersInfo только для bmp.

uses
ComObj, ShlObj;

procedure ChangeActiveWallpaper;
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  ActiveDesktop: IActiveDesktop;
begin
  ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
  ActiveDesktop.SetWallpaper('c:\windows\forest.jpg', 0);
  ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;

Автор:

Vasya2000

Взято из

Как установить переменные окружения?

Следующая простая подпрограмма создаёт новые значения в переменных окружения. Если переменной окружения не существует, то она создаётся. Если переменной окружения установить значение пустой строки, то переменная удаляется. Функция возвращает 0, если значение переменной установлено или переменная создана успешно, либо возвратит значение ошибки Windows вслучае неудачи. Обратите внимание, что размер пространства доступного для переменных окружения ограничен.

function SetEnvVarValue(const VarName,
  VarValue: string): Integer;
begin
  // Просто вызываем API функцию
  if Windows.SetEnvironmentVariable(PChar(VarName),
    PChar(VarValue)) then
    Result := 0
  else
    Result := GetLastError;
end;

ЗАМЕЧАНИЕ: данный способ позволяет делать изменения в переменных окружения только для текущего процесса либо для дочерних процессов, порождённых текущим.

Для того, чтобы передать какую-либо переменную окружения в дочерний процесс просто:

1) Создайте новую переменную окружения при помощи SetDOSEnvVar.
2) Запустите новую программу.

А вот как выглядит пример передачи текущих переменных окружения + переменной FOO=Bar в дочерний процесс:

{ snip ... }
var
  ErrCode: Integer;
begin
  ErrCode := SetEnvVarValue('FOO', 'Bar');
  if ErrCode = 0 then
    WinExec('MyChildProg.exe', SW_SHOWNORMAL);
  else
    ShowMessage(SysErrorMessage(ErrCode));
end;
{ ... end snip }

Взято с Исходников.ru

Как установить разрешение экрана?

ChangeDisplaySettings

Автор cpu
Взято с Vingrad.ru

function SetFullscreenMode:Boolean;
var DeviceMode : TDevMode;
begin
with DeviceMode do begin
  dmSize:=SizeOf(DeviceMode);
  dmBitsPerPel:=16;
  dmPelsWidth:=640;
  dmPelsHeight:=480;
  dmFields:=DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
  result:=False;
  if ChangeDisplaySettings(DeviceMode,CDS_TEST or CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL
   then Exit;
  Result:=ChangeDisplaySettings(DeviceMode,CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL;
end;
end;

procedure RestoreDefaultMode;
var T : TDevMode absolute 0;
begin
ChangeDisplaySettings(T,CDS_FULLSCREEN);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if setFullScreenMode then begin
  sleep(7000);
  RestoreDefaultMode;
end;
end;

Зайцев О.В.
Владимиров А.М.
Взято с Исходников.ru

Как уведомить все приложения, что реестр был изменён?

Для этого можно послать в систему широковещательное сообщение WM_WININICHANGE, указав в нём, что изменения касаются реестра. Большинство приложений, работа которых связана с реестром, должны реагировать на сообщение WM_WININICHANGE.

Пример:

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(HWND_BROADCAST,WM_WININICHANGE,0,LongInt(PChar('RegistrySection')));
end;

Взято с Исходников.ru

Как увеличить процессорное время, выделяемого программе?

Следующий пример изменяет приоритет приложения. Изменение приоритета следует использовать
с осторожностью - т.к. присвоение слишком высокого приоритета может привети к
медленной работе остальных программ и системы в целом. См. Win32 help for SetThreadPriority() function.

  procedure TForm1.Button1Click(Sender: TObject);
  var    ProcessID : DWORD;
   ProcessHandle : THandle;
   ThreadHandle : THandle;
begin
       ProcessID := GetCurrentProcessID;
      ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,
                                        false,  ProcessID);
  SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
  ThreadHandle := GetCurrentThread;
  SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
end;

Взято с сайта

Как узнать адрес LPT-порта?

Эта функция работает в Win95 и Win98.

function GetPortAddress(PortNo: integer): word; assembler; stdcall;
asm
  push es
  push ebx
  mov ebx, PortNo
  shl ebx,1
  mov ax,40h // Dos segment adress
  mov es,ax
  mov ax,ES:[ebx+6] // get port adress in 16Bit way :)
  pop ebx
  pop es
end;

Для NT можно заглянуть сюда:

Взято с Исходников.ru

Как узнать browser по умолчанию?

{
First we create a temporary file and call the
function FindExecutable to get the associated Application.
}

function GetAppName(Doc: string): string;
var
  FN, DN, RES: array[0..255] of char;
begin
  StrPCopy(FN, DOC);
  DN[0]  := #0;
  RES[0] := #0;
  FindExecutable(FN, DN, RES);
  Result := StrPas(RES);
end;

function GetTempFile(const Extension: string): string;
var
  Buffer: array[0..MAX_PATH] of char;
  aFile: string;
begin
  GetTempPath(SizeOf(Buffer) - 1, Buffer);
  GetTempFileName(Buffer, 'TMP', 0, Buffer);
  SetString(aFile, Buffer, StrLen(Buffer));
  Result := ChangeFileExt(aFile, Extension);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  f: System.Text;
  temp: string;
begin
  // get a unique temporary file name
  // eine eindeutige Temporare Datei bekommen
  temp := GetTempFile('.htm');
  // Create the file
  // Datei erstellen
  AssignFile(f, temp);
  rewrite(f);
  closefile(f);
  // Show the path to the browser
  // Pfad + Programmname zum Browser anzeigen.
  ShowMessage(GetAppName(temp));
  // Finally delete the temporary file
  // Temporaare Datei wieder loschen
  Erase(f);
end;

//Using the Registry:
//************************************************

uses
  Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  Reg: TRegistry;
  KeyName: string;
  ValueStr: string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    KeyName     := 'htmlfile\shell\open\command';
    if Reg.OpenKey(KeyName, False) then
    begin
      ValueStr := Reg.ReadString('');
      Reg.CloseKey;
      ShowMessage(ValueStr);
    end
    else
      ShowMessage('There is nоt a default browser');
  finally
    Reg.Free;
  end;
end;

//************************************************
{Copyright (c) by Code Central}

type
  TBrowserInformation = record
    Name: string;
    Path: string;
    Version: string;
  end;

function LongPathName(ShortPathName: string): string;
var
  PIDL: PItemIDList;
  Desktop: IShellFolder;
  WidePathName: WideString;
  AnsiPathName: AnsiString;
begin
  Result := ShortPathName;
  if Succeeded(SHGetDesktopFolder(Desktop)) then
  begin
    WidePathName := ShortPathName;
    if Succeeded(Desktop.ParseDisplayName(0, nil, PWideChar(WidePathName),
      ULONG(nil^), PIDL, ULONG(nil^))) then

      try
        SetLength(AnsiPathName, MAX_PATH);
        SHGetPathFromIDList(PIDL, PChar(AnsiPathName));
        Result := PChar(AnsiPathName);

      finally
        CoTaskMemFree(PIDL);
      end;
  end;
end;

function GetDefaultBrowser: TBrowserInformation;
var
  tmp: PChar;
  res: LPTSTR;
  Version: Pointer;
  VersionInformation: Pointer;
  VersionInformationSize: Integer;
  Dummy: DWORD;
begin
  tmp := StrAlloc(255);
  res := StrAlloc(255);
  Version := nil;
  try
    GetTempPath(255, tmp);
    if FileCreate(tmp + 'htmpl.htm') <> -1 then
    begin
      if FindExecutable('htmpl.htm', tmp, res) > 32 then
      begin
        Result.Name := ExtractFileName(res);
        Result.Path := LongPathName(ExtractFilePath(res));
        // Try to determine the Browser Version
        VersionInformationSize := GetFileVersionInfoSize(Res, Dummy);
        if VersionInformationSize > 0 then
        begin
          GetMem(VersionInformation, VersionInformationSize);
          GetFileVersionInfo(Res, 0, VersionInformationSize, VersionInformation);
          VerQueryValue(VersionInformation, ('StringFileInfo040904E4ProductVersion'),
            Pointer(Version), Dummy);
          if Version <> nil then
            Result.Version := PChar(Version);
          FreeMem(VersionInformation);
        end;
      end
      else
        ShowMessage('Cannot determine the executable.');
      SysUtils.DeleteFile(tmp + 'htmpl.htm');
    end
    else
      ShowMessage('Cannot create temporary file.');
  finally
    StrDispose(tmp);
    StrDispose(res);
  end;
end;

Взято с сайта

Как узнать букву CD-ROM?

var DriveType: UInt;

DriveType := GetDriveType(PChar('F:\'));
if DriveType = DRIVE_CDROM then ShowMessage('Сидюк');

Взято с сайта

Как узнать, была ли перемещена форма?

(...)

type
  TfrmMain = class(TForm)
  private
    procedure OnMove(var Msg: TWMMove); message WM_MOVE;
  end;

  (...)

procedure TfrmMain.OnMove(var Msg: TWMMove);
begin
  inherited;
  (...)
end;

(...)

Взято с Исходников.ru

Как узнать доступен ли DCOM?

functionIsDCOMEnabled: Boolean;
var
  Ts: string;
  R: TRegistry;
begin
  r := TRegistry.Create;
  r.RootKey := HKEY_LOCAL_MACHINE;
  r.OpenKey('Software\Microsoft\OLE', False);
  ts := AnsiUpperCase(R.ReadString('EnableDCOM'));
  r.Free;
  Result := (Ts = 'Y');
end;

Взято с

Delphi Knowledge Base

function IsDCOMInstalled: Boolean;
var
  OLE32: HModule;
begin
  Result := not (IsWin95 or IsWin95OSR2);
  if not Result then
  begin
    OLE32 := LoadLibrary(COLE32DLL);
    if OLE32 > 0 then
    try
      Result := GetProcAddress(OLE32, PChar('CoCreateInstanceEx')) <> nil;
    finally
      FreeLibrary(OLE32);
    end;
  end;
end;

Взято с

Delphi Knowledge Base

Как узнать, доступен ли в сети сервер MS SQL?

Здесь представлена функция, выполняющая проверку доступности MS SQL сервера.

Function CheckMSSQLServer(fServerName, fUserName, fPsw : String) : Bool;
Var
  wDb : TDatabase;
begin  // Check if MS SQL Server is reachable
  // Важно! BDE Должна быть установлена
  Result := False;
  wDb := TDatabase.Create(nil);

  with wDb do
    begin
      DatabaseName := 'wDbDatabaseName'; // arbitrary name, must be unique
                                         // in current Session
      Params.Values['SERVER Name'] := fServerName;
      Params.Values['USER Name']   := fUserName;
      Params.Values['PASSWORD']    := fPsw;
      LoginPrompt := False;
    end;

  try
    wDb.DriverName := 'MSSQL';
    try
      wDb.Connected := True;
      wDb.Connected := False;
    except
      ShowMessage('Server is not reachable');
    end;
    Result := True;
  finally
    wDb.Free;
  end;
end;

Взято с Исходников.ru

Как узнать есть ли у мыши колесико?

Свойство "WheelPresent" глобального обьекта "mouse".

Как узнать, есть ли в приёмном буфере RS232 данные?

При помощи функции ClearCommError можно узнать, сколько байт данных находится в буфере приёма (и буфере передачи) последовательного интерфейса.

procedure DataInBuffer(Handle: THandle;
                       var InQueue, OutQueue: integer);
var ComStat: TComStat;
    e: integer;
begin
  if ClearCommError(Handle, e, @ComStat) then
  begin
    InQueue := ComStat.cbInQue;
    OutQueue := ComStat.cbOutQue;
  end
  else
  begin
    InQueue := 0;
    OutQueue := 0;
  end;
end;

Взято с Исходников.ru

Как узнать есть ли в заданном CD-ROM'е Audio CD?

Можно использовать функцию Windows API GetDriveType() чтобы определить является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы проверить VolumeName на равенство 'Audio CD'.
Пример:

functionIsAudioCD(Drive : char) : bool;
var
   DrivePath : string;
   MaximumComponentLength : DWORD;
   FileSystemFlags : DWORD;
   VolumeName : string;
Begin
   sult := false;
   DrivePath := Drive + ':\';
   if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then
      exit;
   SetLength(VolumeName, 64);
   GetVolumeInformation(PChar(DrivePath),PChar(VolumeName),
   Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);
   if lStrCmp(PChar(VolumeName),'Audio CD') = 0 then
      result := true;
end;

function PlayAudioCD(Drive : char) : bool;
var
   mp : TMediaPlayer;
begin
   result := false;
   Application.ProcessMessages;
   if not IsAudioCD(Drive) then
      exit;
   mp := TMediaPlayer.Create(nil);
   mp.Visible := false;
   mp.Parent := Application.MainForm;
   mp.Shareable := true;
   mp.DeviceType := dtCDAudio;
   mp.FileName := Drive + ':';
   mp.Shareable := true;
   mp.Open;
   Application.ProcessMessages;
   mp.Play;
   Application.ProcessMessages;
   mp.Close;
   Application.ProcessMessages;
   mp.free;
   result := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not PlayAudioCD('D') then
      ShowMessage('Not an Audio CD');
end;

Взято из
DELPHI VCL FAQ

Перевод с английского
Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
специально для

Как узнать физические координаты каретки в пикселях?

{TRichEdit}

var
pt: TPoint;
begin
  with richedit1 do
  begin
    Perform(messages.EM_POSFROMCHAR, WPARAM(@pt), selstart);
    label1.caption := Format('(%d, %d)', [pt.x, pt.y]);
  end;
end;

{TMemo and TEdit}

var
  r: LongInt;
begin
  with memo1 do
  begin
    r := Perform(messages.EM_POSFROMCHAR, selstart, 0);
    if r >= 0 then
    begin
      label1.caption := IntToStr(HiWord(r));
      label2.caption := IntToStr(LoWord(r));
    end;
  end;
end;

Взято с

Delphi Knowledge Base

Как узнать физическое расположение локальной БД по Alias?

По Table(Query).Database:

uses
DbiProcs;

function GetDirByDatabase(Database: TDatabase): string;
var
  pszDir: PChar;
begin
  pszDir := StrAlloc(255);
  try
    DbiGetDirectory(Database.Handle, True, pszDir);
    Result := StrPas(pszDir);
  finally
    StrDispose(pszDir);
  end;
end;

По алиасу:

function GetPhNameByAlias(sAlias: string): string;
var
  Database: TDatabase;
  pszDir: PChar;
begin
  Database := TDatabase.Create(nil); {allocate memory}
  pszDir := StrAlloc(255);
  try
    Database.AliasName := sAlias;
    Database.DatabaseName := 'TEMP'; {requires a name -- is ignored}
    Database.Connected := True; {connect without opening any table}
    DbiGetDirectory(Database.Handle, True, pszDir); {get the dir.}
    Database.Connected := False; {disconnect}
    Result := StrPas(pszDir); {convert to a string}
  finally
    Database.Free; {free memory}
  end;
end;

Взято из

Как узнать имена установленных в системе COM-портов?

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
  reg : TRegistry;
  ts : TStrings;
  i : integer;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('hardware\devicemap\serialcomm',
              false);
  ts := TStringList.Create;
  reg.GetValueNames(ts);
  for i := 0 to ts.Count -1 do begin
    Memo1.Lines.Add(reg.ReadString(ts.Strings[i]));
  end;
  ts.Free;
  reg.CloseKey;
  reg.free;
end;

Взято с Исходников.ru

Как узнать имя домена Windows NT/2000?

function GetNTDomainName: string;
var hReg: TRegistry;
begin
hReg := TRegistry.Create;
hReg.RootKey := HKEY_LOCAL_MACHINE;
hReg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion
\Winlogon', false );
Result := hReg.ReadString( 'DefaultDomainName' );
hReg.CloseKey;
hReg.Destroy;
end;

Взято с Исходников.ru

Как узнать имя файла моей программы?

Application.ExeName
ParamStr(0)
GetModuleFileName()

Автор ответа: rhf
Взято с Vingrad.ru

Как узнать имя файла текущего процесса?

Для этого существует функция GetModuleFileName, которая возвращает имя файла текущего процесса.

function GetModName: String;
var
  fName: String;
  nsize: cardinal;
begin
  nsize := 128;
  SetLength(fName,nsize);
  SetLength(fName,
            GetModuleFileName(
              hinstance,
              pchar(fName),
              nsize));
  Result := fName;
end;

Взято с Исходников.ru

Как узнать имя компьютера?

Function ReadComputerName:string;
var
i:DWORD;
p:PChar;
begin
i:=255;
GetMem(p, i);
GetComputerName(p, i);
Result:=String(p);
FreeMem(p);
end;

Автор Vit
Взято с Vingrad.ru

Как узнать имя пользователя?

Function GetUserFromWindows: string;
Var
  UserName    : string;
  UserNameLen : Dword;
Begin
  UserNameLen := 255;
  SetLength(userName, UserNameLen);
  If GetUserName(PChar(UserName), UserNameLen) Then
    Result := Copy(UserName,1,UserNameLen - 1)
  Else
    Result := 'Unknown';
End;

Взято с Исходников.ru

Как узнать IP адрес?

HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\NetTrans\ (для 98-винды)
Ищем параметр IPAddress
Программно можно определить следующим образом:

var
  WSAData: TWSAData;
  p: PHostEnt;
  Name: array[0..$FF] of Char;
begin
  WSAStartup($0101, WSAData);
  GetHostName(name, $FF);
  p := GetHostByName(Name);
  showmessage(inet_ntoa(PInAddr(p.h_addr_list^)^));
  WSACleanup;
end;

Оксана (oksana@wtgres.pssr.ru)
Взято с сайта

Как узнать количество цветов в системной палитре?

function GetNumColors: LongInt;
var
  BPP: Integer;
  DC: HDC;
begin
  DC := CreateDC('DISPLAY', nil, nil, nil);
  if DC <> 0 then
    begin
      try
        BPP := GetDeviceCaps(DC, BITPIXEL) * GetDeviceCaps(DC, PLANES);
      finally
        DeleteDC(DC);
      end;
      case BPP of
        1: Result := 2;
        4: Result := 16;
        8: Result := 256;
        15: Result := 32768;
        16: Result := 65536;
        24: Result := 16777216;
      end;
    end
  else
    Result := 0;
end;

Как узнать количество видимых строчек в TMemo?

function LinesVisible(Memo: TMemo): integer;
    Var
      OldFont : HFont;
      Hand : THandle;
      TM : TTextMetric;
      Rect  : TRect;
      tempint : integer;
    begin
      Hand := GetDC(Memo.Handle);
      try
        OldFont := SelectObject(Hand, Memo.Font.Handle);
        try
          GetTextMetrics(Hand, TM);
          Memo.Perform(EM_GETRECT, 0, longint(@Rect));
          tempint := (Rect.Bottom - Rect.Top) div
             (TM.tmHeight + TM.tmExternalLeading);
        finally
          SelectObject(Hand, OldFont);
        end;
      finally
        ReleaseDC(Memo.Handle, Hand);
      end;
      Result := tempint;
    end;

Взято с Исходников.ru

Как узнать конфигурацию железа?

Вот компонент для этого нашел:

описание от авторов:

File: msi.zip
Product: MiTeC System Information Component
Version: 6.2
Author: MichaL MutL
E-Mail: michal.mutl@atlas.cz
Target: Delphi 5.x, Delphi 6.x
Platform: W95, W98, NT, W2000, Windows ME, Windows XP
Status: Fully Functional
Source: Included
Description: Component providing detailed system information
+ Registered organization, owner
+ Time Zone info
+ Machine name, IP address, MAC Address
+ Last boot date and time, Boot time
+ CPU architecture, type, active mask, count, level, revision, vendor, id, speed,
+ OS version, build number, platform, CSD version, version name, user name, serial number
+ DVD Region, folders
+ Graphic adapter chip name, dac, memory, screen width and height, color depth, modes
+ Sound card name, WaveIn, WaveOut, MIDIIn, MIDIOut, AUX, Mixer device name
+ Printers
+ Memory info, allocation granularity, min.and max.application address
+ Disk info, file system, controllers
+ BIOS name, copyright, extended info, date
+ Video BIOS version and date
+ Network adapter, protocols, sevices, clients,
+ Winsock info
+ BDE, ODBC, DAO, ADO version
+ DirectX info
+ Device overview (like Device Manager)
+ Win9x resources
+ Running process enumeration
+ Installed software enumeration
+ Startup runs enumeration
+ Performance Library interface (NT & 9x)
+ Internet settings
+ Sharepoints enumeration
+ Component showing CPU usage
Взято с Vingrad.ru

Почти все о железе можно прочитать из регистра по HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\

Автор ответа: Diamond cat
Взято с Vingrad.ru

Как узнать минимальные поля для принтера?

uses
  Printers;

type
  TMargins = record
    Left,
    Top,
    Right,
    Bottom: Double
end;

procedure GetPrinterMargins(var Margins: TMargins);
var
  PixelsPerInch: TPoint;
  PhysPageSize: TPoint;
  OffsetStart: TPoint;
  PageRes: TPoint;
begin
  PixelsPerInch.y := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  PixelsPerInch.x := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  Escape(Printer.Handle, GETPHYSPAGESIZE, 0, nil, @PhysPageSize);
  Escape(Printer.Handle, GETPRINTINGOFFSET, 0, nil, @OffsetStart);
  PageRes.y := GetDeviceCaps(Printer.Handle, VERTRES);
  PageRes.x := GetDeviceCaps(Printer.Handle, HORZRES);
  // Top Margin
  Margins.Top := OffsetStart.y / PixelsPerInch.y;
  // Left Margin
  Margins.Left := OffsetStart.x / PixelsPerInch.x;
  // Bottom Margin
  Margins.Bottom := ((PhysPageSize.y - PageRes.y) / PixelsPerInch.y) -
    (OffsetStart.y / PixelsPerInch.y);
  // Right Margin
  Margins.Right := ((PhysPageSize.x - PageRes.x) / PixelsPerInch.x) -
    (OffsetStart.x / PixelsPerInch.x);
end;

function InchToCm(Pixel: Single): Single;
// Convert inch to Centimeter
begin
  Result := Pixel * 2.54
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Margins: TMargins;
begin
GetPrinterMargins(Margins);
ShowMessage(Format('Margins: (Left: %1.3f, Top: %1.3f, Right: %1.3f, Bottom: %1.3f)',
  [InchToCm(Margins.Left),
   InchToCm(Margins.Top),
   InchToCm(Margins.Right),
   InchToCm(Margins.Bottom)]));
end;

Взято с сайта

Как узнать, находится ли дискета в дисководе?

type TDriveState(DS_NO_DISK, DS_UNFORMATTED_DISK,
    DS_EMPTY_DISK, DS_DISK_WITH_FILES);

function DriveState(DrvLetter: Char): TDriveState;
var Mask: string[6];
    SearchRec: TSearchRec;
    oldMode: Cardinal; ReturnCode: Integer;
begin
  oldMode: = SetErrorMode(SEM_FAILCRITICALERRORS);
  Mask := '?:\*.*'; Mask[1] := DrvLetter; {$I-} { отключить обработку исключительных ситуаций }
  ReturnCode := FindFirst(Mask, faAnyfile, SearchRec);
  FindClose(SearchRec); {$I+} case ReturnCode of
   { как минимум один файл был найден }0: Result := DS_DISK_WITH_FILES;
   { файлов не найдено и дискета в порядке }-18: Result := DS_EMPTY_DISK;
   { DS_NO_DISK для DOS, ERROR_NOT_READY для WinNT,
                ERROR_PATH_NOT_FOUND для Win 3.1 }
    -21, -3: Result := DS_NO_DISK;
  else { дискета лежит в дисководе но она не форматировнная }
    Result := DS_UNFORMATTED_DISK; end;
  SetErrorMode(oldMode); end; { DriveState }

Взято с сайта

Как узнать, находится ли мышка на форме?

Для этого можно воспользоваться API функцией GetCapture().

procedure TForm1.FormDeactivate(Sender: TObject);
begin
  ReleaseCapture;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  If GetCapture = 0 then
    SetCapture(Form1.Handle);
  if PtInRect(Rect(Form1.Left,
                   Form1.Top,
                   Form1.Left + Form1.Width,
                   Form1.Top + Form1.Height),
                   ClientToScreen(Point(x, y))) then
  Form1.Caption := 'Мышка на форме' else
  Form1.Caption := 'Мышка за пределами формы';
end;

Взято с Исходников.ru

Как узнать номер автоинкремента при вставке новой записи?

We have a table in MsAccess like :

Test, Fields (id=autoinc, name=text);

First we have to have a function like the one below :

functionGetLastInsertID: integer;
begin
  // datResult = TADODataSet
  datResult.Active := False;
  datResult.CommandText := 'select @@IDENTITY as [ID]';
  datResult.Active := True;
  Result := datResult.FieldByName('id').AsInteger;
  datResult.Active := False;
end;

Now before getting the last inserted record record id = autoincrement field, in other words calling the above function. You have to do a SQL insert like the following

procedure InsertRec;
begin
  // datCommand = TADOCommand
  datCommand.CommandText := 'insert into [test] ( [name] ) values ( "Test" )';
  datCommand.Execute;
end;

Now if we like to know which is the last autoinc value ( notice that the getlastinsertid proc. only works after the insertrec proc)

procedure Test;
begin
  InsertRec;
  Showmessage(format('lastinsertid : %d', [GetLastInsertID]));
end;

Hope you can make this work, it works for me, any questions feel free to ask

Взято с

Delphi Knowledge Base