Как сделать калькулятор в Delphi?

Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.

Как Delphi реализует многоплатформенную разработку?

Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...

Как работать с реестром, используя только WinAPI

Советы » Реестр » Как работать с реестром, используя только WinAPI

unit
 apiregistry;

interface


uses
 Windows;

function
 RegSetString(RootKey: HKEY; Name: string
; Value: string
): boolean;
function
 RegSetMultiString(RootKey: HKEY; Name: string
; Value: string
): boolean;
function
 RegSetExpandString(RootKey: HKEY; Name: string
; Value: string
): boolean;
function
 RegSetDWORD(RootKey: HKEY; Name: string
; Value: Cardinal): boolean;
function
 RegSetBinary(RootKey: HKEY; Name: string
; Value: array
 of
 Byte): boolean;
function
 RegGetString(RootKey: HKEY; Name: string
; var
 Value: string
): boolean;
function
 RegGetMultiString(RootKey: HKEY; Name: string
; var
 Value: string
): boolean;
function
 RegGetExpandString(RootKey: HKEY; Name: string
; var
 Value: string
): boolean;
function
 RegGetDWORD(RootKey: HKEY; Name: string
; var
 Value: Cardinal): boolean;
function
 RegGetBinary(RootKey: HKEY; Name: string
; var
 Value: string
): boolean;
function
 RegGetValueType(RootKey: HKEY; Name: string
; var
 Value: Cardinal): boolean;
function
 RegValueExists(RootKey: HKEY; Name: string
): boolean;
function
 RegKeyExists(RootKey: HKEY; Name: string
): boolean;
function
 RegDelValue(RootKey: HKEY; Name: string
): boolean;
function
 RegDelKey(RootKey: HKEY; Name: string
): boolean;
function
 RegConnect(MachineName: string
; RootKey: HKEY; var
 RemoteKey: HKEY): boolean;
function
 RegDisconnect(RemoteKey: HKEY): boolean;
function
 RegEnumKeys(RootKey: HKEY; Name: string
; var
 KeyList: string
): boolean;
function
 RegEnumValues(RootKey: HKEY; Name: string
; var
 ValueList: string
): boolean;

implementation


function
 LastPos(Needle: Char; Haystack: string
): integer;
begin

  for
 Result := Length(Haystack) downto
 1 do

    if
 Haystack[Result] = Needle then

      Break;
end
;

function
 RegConnect(MachineName: string
; RootKey: HKEY; var
 RemoteKey: HKEY):
  boolean;
begin

  Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) =
    ERROR_SUCCESS);
end
;

function
 RegDisconnect(RemoteKey: HKEY): boolean;
begin

  Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
end
;

function
 RegSetValue(RootKey: HKEY; Name: string
; ValType: Cardinal; PVal:
  Pointer; ValSize: Cardinal): boolean;
var

  SubKey: string
;
  n: integer;
  dispo: DWORD;
  hTemp: HKEY;
begin

  Result := False;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil
, REG_OPTION_NON_VOLATILE,
      KEY_WRITE,
      nil
, hTemp, @dispo) = ERROR_SUCCESS then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);
      Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize)
        = ERROR_SUCCESS);
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegGetValue(RootKey: HKEY; Name: string
; ValType: Cardinal; var
 PVal:
  Pointer;
  var
 ValSize: Cardinal): boolean;
var

  SubKey: string
;
  n: integer;
  MyValType: DWORD;
  hTemp: HKEY;
  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
      then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);
      if
 RegQueryValueEx(hTemp, PChar(SubKey), nil
, @MyValType, nil
, @BufSize) =
        ERROR_SUCCESS then

      begin

        GetMem(Buf, BufSize);
        if
 RegQueryValueEx(hTemp, PChar(SubKey), nil
, @MyValType, Buf, @BufSize)
          = ERROR_SUCCESS then

        begin

          if
 ValType = MyValType then

          begin

            PVal := Buf;
            ValSize := BufSize;
            Result := True;
          end

          else

          begin

            FreeMem(Buf);
          end
;
        end

        else

        begin

          FreeMem(Buf);
        end
;
      end
;
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegSetString(RootKey: HKEY; Name: string
; Value: string
): boolean;
begin

  Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value)
    + 1);
end
;

function
 RegSetMultiString(RootKey: HKEY; Name: string
; Value: string
): boolean;
begin

  Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0),
  Length(Value) + 2);
end
;

function
 RegSetExpandString(RootKey: HKEY; Name: string
; Value: string
):
  boolean;
begin

  Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0),
    Length(Value) + 1);
end
;

function
 RegSetDword(RootKey: HKEY; Name: string
; Value: Cardinal): boolean;
begin

  Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
end
;

function
 RegSetBinary(RootKey: HKEY; Name: string
; Value: array
 of
 Byte):
  boolean;
begin

  Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)],
    length(Value));
end
;

function
 RegGetString(RootKey: HKEY; Name: string
; var
 Value: string
): boolean;
var

  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  if
 RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);
    SetLength(Value, BufSize);
    if
 BufSize > 0 then

      CopyMemory(@Value[1], Buf, BufSize);
    FreeMem(Buf);
    Result := True;
  end
;
end
;

function
 RegGetMultiString(RootKey: HKEY; Name: string
; var
 Value: string
):
  boolean;
var

  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  if
 RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);
    SetLength(Value, BufSize);
    if
 BufSize > 0 then

      CopyMemory(@Value[1], Buf, BufSize);
    FreeMem(Buf);
    Result := True;
  end
;
end
;

function
 RegGetExpandString(RootKey: HKEY; Name: string
; var
 Value: string
):
  boolean;
var

  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  if
 RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then

  begin

    Dec(BufSize);
    SetLength(Value, BufSize);
    if
 BufSize > 0 then

      CopyMemory(@Value[1], Buf, BufSize);
    FreeMem(Buf);
    Result := True;
  end
;
end
;

function
 RegGetDWORD(RootKey: HKEY; Name: string
; var
 Value: Cardinal): boolean;
var

  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  if
 RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then

  begin

    CopyMemory(@Value, Buf, BufSize);
    FreeMem(Buf);
    Result := True;
  end
;
end
;

function
 RegGetBinary(RootKey: HKEY; Name: string
; var
 Value: string
): boolean;
var

  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  if
 RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then

  begin

    SetLength(Value, BufSize);
    CopyMemory(@Value[1], Buf, BufSize);
    FreeMem(Buf);
    Result := True;
  end
;
end
;

function
 RegValueExists(RootKey: HKEY; Name: string
): boolean;
var

  SubKey: string
;
  n: integer;
  hTemp: HKEY;
begin

  Result := False;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
      then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);
      Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil
, nil
, nil
, nil
) =
        ERROR_SUCCESS);
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegGetValueType(RootKey: HKEY; Name: string
; var
 Value: Cardinal):
  boolean;
var

  SubKey: string
;
  n: integer;
  hTemp: HKEY;
  ValType: Cardinal;
begin

  Result := False;
  Value := REG_NONE;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS)
      then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);
      Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil
, @ValType, nil
, nil
)
        = ERROR_SUCCESS);
      if
 Result then

        Value := ValType;
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegKeyExists(RootKey: HKEY; Name: string
): boolean;
var

  SubKey: string
;
  n: integer;
  hTemp: HKEY;
begin

  Result := False;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS
      then

    begin

      Result := True;
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegDelValue(RootKey: HKEY; Name: string
): boolean;
var

  SubKey: string
;
  n: integer;
  hTemp: HKEY;
begin

  Result := False;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
      then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);
      Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegDelKey(RootKey: HKEY; Name: string
): boolean;
var

  SubKey: string
;
  n: integer;
  hTemp: HKEY;
begin

  Result := False;
  n := LastPos('', Name);
  if
 n > 0 then

  begin

    SubKey := Copy(Name, 1, n - 1);
    if
 RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS
      then

    begin

      SubKey := Copy(Name, n + 1, Length(Name) - n);
      Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
      RegCloseKey(hTemp);
    end
;
  end
;
end
;

function
 RegEnum(RootKey: HKEY; Name: string
; var
 ResultList: string
; const

  DoKeys: Boolean): boolean;
var

  i: integer;
  iRes: integer;
  s: string
;
  hTemp: HKEY;
  Buf: Pointer;
  BufSize: Cardinal;
begin

  Result := False;
  ResultList := '';
  if
 RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

  begin

    Result := True;
    BufSize := 1024;
    GetMem(buf, BufSize);
    i := 0;
    iRes := ERROR_SUCCESS;
    while
 iRes = ERROR_SUCCESS do

    begin

      BufSize := 1024;
      if
 DoKeys then

        iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil
, nil
, nil
, nil
)
      else

        iRes := RegEnumValue(hTemp, i, buf, BufSize, nil
, nil
, nil
, nil
);
      if
 iRes = ERROR_SUCCESS then

      begin

        SetLength(s, BufSize);
        CopyMemory(@s[1], buf, BufSize);
        if
 ResultList = '' then

          ResultList := s
        else

          ResultList := Concat(ResultList, #13#10,s);
       inc(i);
      end
;
    end
;
    FreeMem(buf);
    RegCloseKey(hTemp);
  end
;
end
;

function
 RegEnumValues(RootKey: HKEY; Name: string
; var
 ValueList: string
):
  boolean;
begin

  Result := RegEnum(RootKey, Name, ValueList, False);
end
;

function
 RegEnumKeys(RootKey: HKEY; Name: string
; var
 KeyList: string
): boolean;
begin

  Result := RegEnum(RootKey, Name, KeyList, True);
end
;

end
.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2024 - All Rights Reserved - www.delphirus.com