Rosetta Stone

program uname;

uses  baseunix;

var KernelName: UtsName;

begin
 fpuname(KernelName);
 writeln(kernelname.sysname);
 writeln(kernelname.nodename);
 writeln(kernelname.release);
 writeln(kernelname.version);
 writeln(kernelname.machine);
 writeln(kernelname.domain);
end.

function Which(Executable: string): string;
var
  Output: string;
begin
  {$IFDEF UNIX}
  // Note: we're using external which because
  // FindDefaultExecutablePath
  // doesn't check if the user has execute permission
  // on the found file.
  ExecuteCommand('which '+Executable,Output,false);
  // Remove trailing LF(s) and other control codes:
  while (length(output)>0) and (ord(output[length(output)])<$20) do
    delete(output,length(output),1);
  {$ELSE}
  Output:=FindDefaultExecutablePath(Executable);
  {$ENDIF UNIX}
  // Extra check:
  if (Output<>'') and fileexists(Output) then
  begin
    result:=Output;
  end
  else
  begin
    result:=''; //command failed
  end;
end;

uses
  {$IFDEF UNIX}
  {$IF (DEFINED(LINUX)) OR (DEFINED(FREEBSD))}
  ,users //not available on OSX
  {$ENDIF}
  ,baseunix //for fpgetuid
  .... //other unix stuff
  {$ENDIF}
  {$IFDEF MSWINDOWS}
  ,windows
  {$ENDIF}
  ,lazutf8

function UserName: string;
// Get Operating System user name
{$IFDEF WINDOWS}
const
  MaxLen = 256;
var
  Len: DWORD;
  WS: WideString;
  Res: windows.BOOL;
{$ENDIF}
begin
  Result := '';
  {$IFDEF WINDOWS}
    Len := MaxLen;
    {$IFNDEF WINCE}
    // Check for Win98..WinME:
    if Win32MajorVersion <= 4 then
    begin
      SetLength(Result,MaxLen);
      Res := Windows.GetUserName(@Result[1], Len);
      if Res then
      begin
        SetLength(Result,Len-1);
        Result := SysToUtf8(Result);
      end
      else
        SetLength(Result,0);
    end
    else
    {$ENDIF NOT WINCE}
    begin
      SetLength(WS, MaxLen-1);
      Res := Windows.GetUserNameW(@WS[1], Len);
      if Res then
      begin
        SetLength(WS, Len - 1);
        Result := Utf16ToUtf8(WS);
      end
      else
        SetLength(Result,0);
    end;
    {$ENDIF WINDOWS}
    {$IFDEF UNIX}
    {$IF (DEFINED(LINUX)) OR (DEFINED(FREEBSD))}
    Result := SysToUtf8(GetUserName(fpgetuid));
    {$ENDIF}
    if Result = '' then
      Result := GetEnvironmentVariableUTF8('USER'); //fallback or other unixes which export $USER and don't support GetUserName
  {$ENDIF}
end;

unit block_search;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fgl;

type

  { TBlockSearch }
  TBlockSearchResults = specialize TFPGList<int64>;

  TBlockSearch = class
  private
    src:TStream;
    fresults:TBlockSearchResults;
    block:array of byte;
  public
    procedure SearchFor(a:array of byte);
    constructor Create(_Src:TStream; blocksize:integer = 1024*1024);
    destructor Destroy; override;
    property Results:TBlockSearchResults read fResults;
  end;

implementation

{ TBlockSearch }

procedure TBlockSearch.SearchFor(a: array of byte);
var
  readsize:integer;
  fPos:Int64;
  fifoBuff:array of byte;
  fifoSt,fifoEn,searchLen,lpbyte:integer;

  //
  procedure CheckPos;
  var
    l,p:integer;
  begin
    p := fifoST;
    for l := 0 to pred(SearchLen) do
    begin
      if a[l] <> fifoBuff[p] then exit;
      //p := (p+1) mod SearchLen,   the if seems quicker
      inc(p); if p >= SearchLen then p := 0;
    end;
    fresults.Add(fpos-searchLen);
  end;
  //
begin
  fresults.clear;
  src.Position:=0;
  readsize := src.Read(block[0],Length(block));
  searchLen := length(a);
  if searchLen > length(block) then
    raise Exception.Create('Search term larger than blocksize');
  if readsize < searchLen then exit;
  setlength(fifoBuff,searchLen);
  move(block[0],fifoBuff[0],searchLen);
  fPos:=0;
  fifoSt:=0;
  fifoEn:=SearchLen-1;
  CheckPos;
  while readsize > 0 do
  begin
    for lpByte := 0 to pred(readsize) do
    begin
      inc(fifoSt); if fifoSt>=SearchLen then fifoST := 0;
      inc(fifoEn); if fifoEn>=SearchLen then fifoEn := 0;
      fifoBuff[fifoEn] := block[lpByte];
      inc(fPos);
      CheckPos;
    end;
    readsize := src.Read(block[0],Length(block));
  end;
end;

constructor TBlockSearch.Create(_Src: TStream; blocksize: integer);
begin
  inherited Create;
  setlength(block,blocksize);
  src := _src;
  fresults := TBlockSearchResults.Create;
end;

destructor TBlockSearch.Destroy;
begin
  freeAndNil(fresults);
  inherited Destroy;
end;

end.

var
  bs:TBlockSearch;
..
..
  bs := TBlockSearch.Create(SourceFile);
  try
    bs.SearchFor(WhatIAmSearchingFor);
    for i := 0 to bs.results.count-1 do
    begin
      // Example: we need to do something at an offset after the result
      SourceFile.Position := bs.Results.Items[i] + 5;
      SourceFile.ReadBuffer(RecordToParse, SizeOf(RecordToParse)); 
      // And now I work on the data in the second packed record of arrays and output to memo or whatever
    end;
  finally
    bs.free;
  end;

procedure FindAndReplace(SearchFor, ReplaceWith, FileName: string);
var
  FileContents: TStringList;
begin
  FileContents:=TStringList.Create;
  try
    FileContents.LoadFromFile(FileName);
    FileContents.Text:=StringReplace(FileContents.Text, SearchFor, ReplaceWith, [rfReplaceAll,rfIgnoreCase]);
    FileContents.SaveToFile(FileName);
  finally
    FileContents.Free;
  end;
end;