Retorna o IP da Máquina

function GetIP:string;//--> Declare a Winsock na clausula uses da unit

var

  WSAData: TWSAData;

  HostEnt: PHostEnt;

  Name:string;

begin

  WSAStartup(2, WSAData);

  SetLength(Name, 255);

  Gethostname(PChar(Name), 255);

  SetLength(Name, StrLen(PChar(Name)));

  HostEnt := gethostbyname(PChar(Name));

  with HostEnt^ do

    Result:=Format('%d.%d.%d.%d',[Byte(h_addr^[0]),

              Byte(h_addr^[1]),Byte(h_addr^[2]),Byte(h_addr^[3])]);

  WSACleanup;

end;

Desconectar uma unidade de rede mapeada

 function DesconectaRede(Unidade:Pchar;ForcaCancel:boolean):String;

begin

  WNetCancelConnection2(Unidade,0,ForcaCancel);

  Case GetLastError() of

    1205: Result := 'Não foi possível abrir o perfil';

    1206: Result := 'Perfil do usuário não encontrado ou inválido';

    1208: Result := 'Ocorreu um Erro específico na rede';

    2138: Result := 'Rede não encontrada ou fora do ar';

    2250: Result := 'Mapeamento inválido ou não encontrado';

    2401: Result := 'Existem muitos arquivos abertos';

    else Result := 'Unidade disconectada com sucesso';

  end;

end;

Travar as teclas: Alt+Tab, Ctrl+Esc, Ctrl+Alt+Del

var OldValue : LongBool;

begin

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

end;

Destravar as teclas: Alt+Tab, Ctrl+Esc, Ctrl+Alt+Del

var OldValue : LongBool;

begin

  SystemParametersInfo(97, Word(False), @OldValue, 0);

end;

Esconder a aplicação da barra de tarefas

var H : HWnd;

begin

  H := FindWindow(Nil,'Project1');

  if H <> 0 then

    ShowWindow(H,SW_HIDE);

end; 

Executar Pack em Tabelas Paradox

procedure ParadoxPack(Table : TTable);

var

  TBDesc : CRTblDesc;

  hDb: hDbiDb;

  TablePath: array[0..dbiMaxPathLen] of char;

begin

  FillChar(TBDesc,Sizeof(TBDesc),0);

  with TBDesc do

  begin

    StrPCopy(szTblName,Table.TableName);

    StrPCopy(szTblType,szParadox);

    bPack := True;

  end;

  hDb := nil;

  Check(DbiGetDirectory(Table.DBHandle, True, TablePath));

  Table.Close;

  Check(DbiOpenDatabase(nil,'STANDARD',dbiReadWrite,dbiOpenExcl,nil,0,nil,nil,hDb));

  Check(DbiSetDirectory(hDb, TablePath));

  Check(DBIDoRestructure(hDb,1,@TBDesc,nil,nil,nil,False));

  Table.Open;

end;

Trocar a resolução de vídeo

function TrocaResolucao(X, Y: word): Boolean;

var lpDevMode: TDeviceMode;

begin

  if EnumDisplaySettings(nil, 0, lpDevMode) then

  begin

    lpDevMode.dmFields := DM_PELSWIDTH Or DM_PELSHEIGHT;

    lpDevMode.dmPelsWidth := X;

    lpDevMode.dmPelsHeight:= Y;

    Result := ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;

  end;

end;

Nome do computador (topo)

function NomeComputador : String;

var

  lpBuffer : PChar;

  nSize : DWord;

const Buff_Size = MAX_COMPUTERNAME_LENGTH + 1;

begin

  nSize := Buff_Size;

  lpBuffer := StrAlloc(Buff_Size);

  GetComputerName(lpBuffer,nSize);

  Result := String(lpBuffer);

  StrDispose(lpBuffer);

end;

Inicializar vários EDITs em um formulário (topo)

procedure TForm1.Button1Click(Sender: TObject);

var contador : integer;

begin

  for contador := 0 to (Form1.ControlCount - 1) do

    if Form1.Controls[contador].ClassName = 'TEdit' then

      (Form1.Controls[contador] as TEdit).Text := '';

end;

Mudar a cor da linha de um DBGrid (topo)

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; .....);

begin

  if odd(field.DataSet.RecNo) then

    DBGrid1.Canvas.Font.Color := clBlue

  else DBGrid1.Canvas.Font.Color := clWhite;

  DBGrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, state);

end; 

Desabilita o botão Fechar do Formulário (topo)

procedure TForm1.FormCreate(Sender: TObject);

var

  hwndHandle : THANDLE;

  hMenuHandle : HMenu;

begin

  hwndHandle := Self.Handle;

  if (hwndHandle <> 0) then

  begin

    hMenuHandle := GetSystemMenu(hwndHandle, FALSE);

    if (hMenuHandle <> 0) then

      DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);

  end;

end;