Ağdaki bilgisayar adlarını listeleme (List Network Computers)

procedure EnumNetResources(List: TStrings);

 procedure EnumFunc(NetResource: PNetResource);

 var

   Enum: THandle;

   Count, BufferSize: DWORD;

   Buffer: array[0..16384 div SizeOf(TNetResource)] of TNetResource;

   i: Integer;

   tstr: string;

 begin

   if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, NetResource,

Enum) = NO_ERROR then

   try

     Count := $FFFFFFFF;

     BufferSize := SizeOf(Buffer);

     while WNetEnumResource(Enum, Count, @Buffer, BufferSize) = NO_ERROR do

       for i := 0 to Count - 1 do

       begin

         if Buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then

         begin

           tstr := Buffer[i].lpRemoteName;

           delete(tstr,1,2);

           List.Add(tstr);

         end;

         if (Buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then

           EnumFunc(@Buffer[i])

       end;

   finally

     WNetCloseEnum(Enum);

   end;

 end;

begin

 List.Clear;

 EnumFunc(nil);

end;

Örnek Kullanım:

procedure TForm1.Button1Click(Sender: TObject);

begin

  EnumNetResources(ListBox1.Items);

end;

Kill the Mouse and Keyboard (Klavye ve Mouse engelleme)

function FunctionDetect(LibName, FuncName: string; var LibPointer: Pointer): Boolean;

var

  LibHandle: THandle;

begin

  Result     := False;

  LibPointer := nil;

  if LoadLibrary(PChar(LibName)) = 0 then Exit;

  LibHandle := GetModuleHandle(PChar(LibName));

  if LibHandle <> 0 then

  begin

    LibPointer := GetProcAddress(LibHandle, PChar(FuncName));

    if LibPointer <> nil then Result := True;

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

  xBlockInput: function (Block: BOOL): BOOL; stdcall;

  OldValue : LongBool;

  begin

    if FunctionDetect('USER32.DLL', 'BlockInput', @xBlockInput) then

    begin

      xBlockInput(True);  // Disable Keyboard & mouse

      //SystemParametersInfo(97,Word(True),@OldValue,0);

      Sleep(10000);         // Wait for 10 Seconds

      xBlockInput(False); // Enable  Keyboard & mouse

    end;

  end;

Draw Alpha Blend Bitmap

const

 AC_SRC_ALPHA = $1;

procedure DrawAlphaBlend (Bitmap:TBitmap; hdcwnd : HDC; Alpha: Byte);

var

    Ahdc : HDC;              // handle of the DC we will create

    bf : BLENDFUNCTION;      // structure for alpha blending

    Ahbitmap : HBITMAP;      // bitmap handle

    bmi : BITMAPINFO;        // bitmap header

    pvBits : pointer;        // pointer to DIB section

    ulWindowWidth,

    ulWindowHeight : ULONG;  // window width/height

    ulBitmapWidth,

    ulBitmapHeight : ULONG; // bitmap width/height

    rt : TRect;             // used for getting window dimensions

    canvas: TCanvas;

begin

    // calculate window width/height

    ulWindowWidth := Bitmap.Width;

    ulWindowHeight := Bitmap.Height;

    // create a DC for our bitmap -- the source DC for AlphaBlend

    Ahdc := CreateCompatibleDC(hdcwnd);

    // zero the memory for the bitmap info

    ZeroMemory(@bmi, sizeof(BITMAPINFO));

    // setup bitmap info

    bmi.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);

    bmi.bmiHeader.biWidth := ulWindowWidth;

    ulBitmapWidth := ulWindowWidth;

    bmi.bmiHeader.biHeight := ulWindowHeight;

    ulBitmapHeight := ulWindowHeight;

    bmi.bmiHeader.biPlanes := 1;

    bmi.bmiHeader.biBitCount := 32;         // four 8-bit components

    bmi.bmiHeader.biCompression := BI_RGB;

    bmi.bmiHeader.biSizeImage := ulBitmapWidth * ulBitmapHeight * 4;

    // create our DIB section and select the bitmap into the dc

    Ahbitmap := CreateDIBSection(Ahdc, bmi, DIB_RGB_COLORS, pvBits, 0, 0);

    SelectObject(Ahdc, Ahbitmap);

    canvas := TCanvas.Create;

    canvas.Handle := Ahdc;

    canvas.Draw(0,0,Bitmap);

    bf.BlendOp := AC_SRC_OVER;

    bf.BlendFlags := 0;

    bf.SourceConstantAlpha := Alpha;  // half of 0xff = 50% transparency

    bf.AlphaFormat := 0;             // ignore source alpha channel

    AlphaBlend(hdcwnd, 0, 0,

                    ulBitmapWidth, ulBitmapHeight,

                    Ahdc, 0, 0, ulBitmapWidth, ulBitmapHeight, bf);

    // do cleanup

    DeleteObject(Ahbitmap);

    DeleteDC(Ahdc);

end;

Delphi Binary Dönüşüm İşlemleri (Binary transformation)

Uses

  Math;

function IntToBinStr(num: integer): string;

var

  i: integer;

begin

  for i := 0 to 31 do

    Result := IntToStr((num shr i) and 1) + Result;

end;

function BinStrToInt(num: string): integer;

var

  i: integer;

begin

  Result := 0;

  for i := length(num) downto 1 do

    Result := Result + strtoint(num[i])*round(Power(2,length(num)-i));

end;