22 Mart 2012 Perşembe

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;