IT science: заметки с тегом lazarus

рекурсивное удаление директории

Fri, 12 Apr 2019 09:06:18 +0300

аналог

rmdir /s /q или rm -rf

function DeleteDirectoryEx(DirectoryName: string): boolean;
// адаптирована функция DeleteDirectory из модуля fileutil, спасибо Павлу Дмитруку
var
  FileInfo: TSearchRec;
  CurSrcDir: String;
  CurFilename: String;
begin
  Result:=false;
  CurSrcDir:=CleanAndExpandDirectory(DirectoryName);
  try
         if FindFirstUTF8(CurSrcDir+GetAllFilesMask,faAnyFile,FileInfo)=0 then
         begin
           repeat
             if (FileInfo.Name<>'.') and (FileInfo.Name<>'..') and (FileInfo.Name<>'') then
             begin
               CurFilename:=CurSrcDir+FileInfo.Name;
               if (FileInfo.Attr and faReadOnly)>0 then
                 FileSetAttrUTF8(CurFilename, FileInfo.Attr-faReadOnly);
               if (FileInfo.Attr and faDirectory)>0 then
               begin
                 if not DeleteDirectoryEx(CurFilename) then exit;
               end
               else
               begin
                 if not DeleteFileUTF8(CurFilename) then exit;
               end;
             end;
           until FindNextUTF8(FileInfo)<>0;
         end;
         FindCloseUTF8(FileInfo);
         if (not RemoveDirUTF8(DirectoryName)) then
           begin
             exit;
             Result:=true;
           end;
  except
    Result:=false;
  end;
end;

запускаем внешнее приложение, ждем завершения и получаем вывод

Thu, 11 Apr 2019 19:00:38 +0300

запускаем внешнее консольное приложение и ждем окончания его выполнения, после завершения получаем вывод в список

function RunScript(sCommand: String): TStringList;
var
  OurCommand: String;
  OutputLines: TStringList;
  MemStream: TMemoryStream;
  OurProcess: TProcess;
  NumBytes: LongInt;
  BytesRead: LongInt;
const
  READ_BYTES = 204800;
begin
  MemStream := TMemoryStream.Create;
  BytesRead := 0;
  OurProcess := TProcess.Create(nil);
  OurCommand := sCommand;
  OurProcess.CommandLine := OurCommand;
  OurProcess.ShowWindow:=swoHIDE;
  OurProcess.Options := [poUsePipes, poNoConsole];
  OurProcess.Execute;
  while OurProcess.Running do
  begin
    MemStream.SetSize(BytesRead + READ_BYTES);
    NumBytes := OurProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES);
    if NumBytes > 0
    then begin
      Inc(BytesRead, NumBytes);
      Sleep(100);
    end
    else begin
      Sleep(100);
    end;
  end;
  Sleep(1000);
  repeat
    MemStream.SetSize(BytesRead + READ_BYTES);
    NumBytes := OurProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES);
    if NumBytes > 0
    then begin
      Inc(BytesRead, NumBytes);
    end;
    Sleep(100);
  until NumBytes <= 0;
  MemStream.SetSize(BytesRead);
  OutputLines := TStringList.Create;
  OutputLines.LoadFromStream(MemStream);
  result := OutputLines;
  OurProcess.Free;
  MemStream.Free;
end;

получаем содержимое url (поддерживается http, https)

Thu, 11 Apr 2019 18:57:32 +0300

Бывает в приложении для windows нужно по ссылке получить какую нибудь информацию, ниже представлена функция, которая это сделает быстро и без дополнительных библиотек

function get_from_server(const Url: string): string;
const
  UserAgent = 'Mozilla/5.0 (compatible)';
var
  hInet: HINTERNET;
  hURL: HINTERNET;
  Buffer: array[0..1023] of AnsiChar;
  BufferLen: cardinal;
begin
  result := '';
  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if hInet = nil then RaiseLastOSError;
  try
    hURL := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0);
    if hURL = nil then RaiseLastOSError;
    try
      repeat
        if not InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) then
          RaiseLastOSError;
        result := result + UTF8Decode(Copy(Buffer, 1, BufferLen))
      until BufferLen = 0;
    finally
      InternetCloseHandle(hURL);
    end;
  finally
    InternetCloseHandle(hInet);
  end;
end;

получаем namingContexts контроллера домена

Thu, 11 Apr 2019 18:53:24 +0300

Некоторую информацию можно получить от контроллера домена без авторизации, например, namingContexts.

function get_ldap_namingContexts(server: string): string;
var
  ldap: TLDAPsend;
  attr: TStringList;
begin
  ldap:= TLDAPsend.Create;
  attr := TStringList.Create;
  attr.Add('namingContexts');
  try
       ldap.TargetHost := server;
       ldap.TargetPort := '389';
         if ldap.Login then
          begin
           if ldap.Bind then
            begin
              ldap.SearchScope:=SS_BaseObject;
              if ldap.Search('', False, '(objectClass=*)', attr) then
               begin
                  result:= ldap.SearchResult.Items[0].Attributes.Get('namingContexts')
               end;
            end;
           ldap.Logout;
          end;
  finally
     ldap.Free;
     attr.Free;
  end;
end;

результатом работы этой функции будет: DC=domain,DC=loc

про другие параметры можно почитать здесь: https://msdn.microsoft.com/en-us/library/ms684291(v=vs.85).aspx

ldapsend, получаем sid в hex формате

Mon, 08 Apr 2019 11:58:04 +0300

функция для тех, кто работает с LDAP (ActiveDirectory)

Все знают, что sid LDAP возвращает в формате bin, сконвертируем в hex строку. Функция делает запрос к серверу и получает objectSid пользователя по sAMAccountName, затем конвертирует его в строку hex с разделителями запятыми. Результатом работы функции будет строка: 01,05,00,00,00,00,00,05,15,00,00,00,8a,1c,a9,8e,20,29,32,58,4f,d1,a7,56,50,04,00,00

фильтр запроса (&(objectClass=user)(sAMAccountName=’+user_name+’)(!(userAccountControl:1.2.840.113556.1.4.803:=2))) исключает заблокированные учетные записи.

не забудьте подключить модуль ldapsend из библиотеки Synapse http://synapse.ararat.cz/doku.php/

function get_bin_sid_by_name(user_name,server,user,password,namingContexts: string): string;
var
  ldap: TLDAPsend;
  attr: TStringList;
  s,str:string;
  l:PAnsiChar;
  l_l:integer;
begin
  ldap:= TLDAPsend.Create;
  attr := TStringList.Create;
  attr.Add('cn');
  attr.Add('sAMAccountName');
  attr.Add('objectSid');
  result:='';

  try
    ldap.TargetHost := server;
    ldap.TargetPort := '389';
    ldap.UserName := user+'@'+copy(namingContexts,4,pos(',', namingContexts)-4);
    ldap.Password := password;
    ldap.SearchScope:=SS_WholeSubtree;
    ldap.SearchSizeLimit:=0;
    ldap.SearchTimeLimit:=0;


    if ldap.Login then
     begin
       if ldap.Bind then
        begin
          if ldap.Search('CN=users,'+namingContexts, False, '(&(objectClass=user)(sAMAccountName='+user_name+')(!(userAccountControl:1.2.840.113556.1.4.803:=2)))', attr) then
             begin
               s:=ldap.SearchResult.Items[0].Attributes.Get('objectSid');
               GetMem(l,length(s));
               BinToHex((@s[1]),l,length(s));
               result:=copy(l,1,length(s)*2);
               str:='';
               for l_l:=0 to length(s)*2 do
                 begin
                   if ((l_l mod 2 = 0) and (l_l<>0) and (l_l<>length(s)*2)) then
                     begin
                      str:=str+result[l_l]+',';
                     end
                   else
                     begin
                       str:=str+result[l_l];
                     end;
                 end;
               result:=trim(str);
             end;
        end;
     end;
  finally
     ldap.Free;
     attr.Free;
  end;
end;

user_name — sAMAccountName пользователя, чей sid хотим получить
server — адрес сервера LDAP
user — логин для авторизации
password — пароль пользователя (достаточно прав обычного пользователя домена для чтения атрибутов)
namingContexts — корень нашего домена, например dc=server,dc=loc