Curso de Delphi: 7.Consultas SQL

WebService Soap em Delphi

Usando API Rest com Delphi 7 de forma simples

Vamos criar uma API REST simples em Delphi. Para isso, usaremos o Delphi 7 com Indy components (se for o que você tem disponível) ou, se estiver usando uma versão mais recente do Delphi (como Delphi XE6+), o ideal é usar o RAD Server (EMS) ou criar via WebBroker.

Como você mencionou anteriormente que trabalha com Delphi 7, vou te mostrar um exemplo simples usando Indy (IdHTTPServer) para criar uma API REST rudimentar. Se estiver usando uma versão mais nova, posso adaptar para WebBroker ou RAD Server, é só avisar.

✅ Exemplo: API REST simples com Delphi 7 e Indy (IdHTTPServer)

Essa API vai responder um JSON simples em uma rota /hello.

1. Coloque os componentes no formulário

TIdHTTPServer (ex: IdHTTPServer1)

TMemo (opcional, para log)

Ative IdHTTPServer1.Active := True;

2. Código de exemplo

uses

IdHTTPServer, IdCustomHTTPServer, SysUtils, Classes, IdContext;

procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;

  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);

begin

  if ARequestInfo.Document = '/hello' then

  begin

    AResponseInfo.ContentType := 'application/json';

    AResponseInfo.ResponseNo := 200;

    AResponseInfo.ContentText := '{"message": "Olá, mundo!"}';

  end

  else

  begin

    AResponseInfo.ResponseNo := 404;

    AResponseInfo.ContentText := '{"error": "Rota não encontrada"}';

  end;

end;

📌 Resultado esperado

Requisição para http://localhost:port/hello retorna:

{"message": "Olá, mundo!"}

✅ Dicas extras

Porta: configure a propriedade DefaultPort do IdHTTPServer1 (ex: 8080).

Métodos GET/POST: você pode usar ARequestInfo.Command para distinguir entre métodos HTTP.

JSON mais complexo: use TStringList ou TMemoryStream para respostas maiores ou arquivos.

Integração Simples Entre Delphi e a Impressora Fiscal

Fazer uma integração simples entre Delphi e uma impressora fiscal depende do modelo e do protocolo da impressora fiscal (Ex: Elgin, Daruma, Epson, Bematech, etc.), mas de forma geral, as impressoras fiscais antigas utilizam comunicação via porta serial (COM) e comandos baseados no Protocolo Fiscal (ECF).

Abaixo está um guia passo a passo para uma integração simples, com exemplo usando comandos diretos via porta serial:

✅ 1. Verifique o modelo e instale o driver da impressora

Antes de tudo, instale o driver oficial da impressora fiscal e anote a porta COM que ela está utilizando (pode ver isso no Gerenciador de Dispositivos).

✅ 2. Comunique-se via porta serial (COM) com Delphi

Delphi pode usar a unit SerialPort ou componentes de terceiros como AsyncPro, mas vamos mostrar um exemplo simples com componente THandle para acesso direto à porta COM.

🧩 Exemplo simples usando CreateFile:

uses

Windows;

function EnviarComandoECF(const Porta, Comando: string): Boolean;

var

  hSerial: THandle;

  BytesWritten: DWORD;

begin

  Result := False;

  hSerial := CreateFile(PChar(Porta),

                        GENERIC_WRITE,

                        0,

                        nil,

                        OPEN_EXISTING,

                        0,

                        0);

  if hSerial = INVALID_HANDLE_VALUE then

  begin

    ShowMessage('Erro ao abrir a porta ' + Porta);

    Exit;

  end;

  if WriteFile(hSerial, PChar(Comando)^, Length(Comando), BytesWritten, nil) then

    Result := True;

  CloseHandle(hSerial);

end;

➕ Como usar:

procedure TForm1.btnImprimirClick(Sender: TObject);

begin

  // Exemplo de comando fiscal (ver manual da impressora para os corretos)

  if EnviarComandoECF('COM1', #27 + 'C') then

    ShowMessage('Comando enviado com sucesso.')

  else

    ShowMessage('Erro ao enviar comando.');

end;

✅ 3. Usando DLL oficial do fabricante (recomendado)

Fabricantes como Daruma, Bematech, Elgin fornecem DLLs com funções prontas como Bematech_FI_AbreCupom, Daruma_FI_AbreCupom, etc.

Exemplo com DLL da Bematech:

function Bematech_FI_AbreCupom(CPF_CNPJ: PChar): Integer; stdcall; external 'BemaFI32.dll';

procedure TForm1.btnCupomClick(Sender: TObject);

begin

  if Bematech_FI_AbreCupom('12345678901') = 1 then

    ShowMessage('Cupom aberto com sucesso.')

  else

    ShowMessage('Erro ao abrir cupom.');

end;

✅ 4. Leia o manual da impressora fiscal

Cada fabricante possui comandos diferentes e exigências fiscais específicas. É essencial obter o manual do desenvolvedor (ECF/ACBr/DLL) da impressora que será utilizada.

✅ 5. Alternativa:
Usar o ACBr (componente gratuito e robusto)

O ACBr é um projeto open source que facilita a integração com equipamentos fiscais.

// Usando ACBrECF

procedure TForm1.btnCupomClick(Sender: TObject);

begin

  ACBrECF1.Modelo := ecfBematech; // ou ecfDaruma, etc.

  ACBrECF1.Porta := 'COM1';

  ACBrECF1.Ativar;

  ACBrECF1.AbreCupom;

  ACBrECF1.VendeItem('123', 'Produto Teste', 'UN', 1, 10, 0, 'T');

  ACBrECF1.SubtotalizaCupom;

  ACBrECF1.EfetuaPagamento('Dinheiro', 10);

  ACBrECF1.FechaCupom('Obrigado!');

end;

✅ Conclusão

Você pode escolher três caminhos:

Comunicação direta via porta COM (mais complexa e arriscada).

Usar a DLL do fabricante (mais seguro e comum).

Usar o ACBr (mais flexível, fácil e atualizado para exigências fiscais do Brasil).

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;

Como converter decimal para romanos em Delphi

function DecToRoman( Decimal: LongInt ): String;

{Converte um numero decimal em algarismos romanos}

const

    Romans: Array[1..13] of String = ( 'I', 'IV', 'V', 'IX', 'X','XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' );

    Arabics: Array[1..13] of Integer =( 1, 4, 5, 9, 10, 40, 50, 90,100, 400, 500, 900, 1000);

var

    i: Integer;

    scratch: String;

begin

  scratch := '';

  for i := 13 downto 1 do

  while ( Decimal >= Arabics[i] ) do

  begin

  Decimal := Decimal - Arabics[i];

  scratch := scratch + Romans[i];

  end;

  Result := scratch;

end;

Colocar uma ProgressBar numa StatusBar

Coloque uma StatusBar no form e adicione dois painéis a ela (propriedade Panels). Ajuste as propriedades do primeiro painel comoStyle = psOwnerDraw e Width = 150. Coloque uma ProgressBar no form e mude sua propriedade Visible para false. No evento OnDrawPanel da StatusBar digite o código abaixo:

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;

Panel: TStatusPanel; const Rect: TRect);

begin

  { Se for o primeiro painel... }

  if Panel.Index = 0 then begin

      { Ajusta a tamanho da ProgressBar de acordo com o tamanho do painel }

      ProgressBar1.Width := Rect.Right - Rect.Left +1;

      ProgressBar1.Height := Rect.Bottom - Rect.Top +1;

      { Pinta a ProgressBar no DC (device-context) da StatusBar }

      ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);

  end;

end;

ColoqueumButtonnoform

DigitenoeventoOnClickdoButtonocódigoabaixo:

procedure TForm1.Button1Click(Sender: TObject);

var

  I: integer;

begin

  for I := ProgressBar1.Min to ProgressBar1.Max do begin

  { Atualiza a posição da ProgressBar }

  ProgressBar1.Position := I;

  { Repinta a StatusBar para forçar a atualização visual }

  StatusBar1.Repaint;

  { Aguarda 50 milisegundos }

  Sleep(50);

  end;

  { Aguarde 500 milisegundos }

  Sleep(500);

  { Reseta (zera) a ProgressBar }

  ProgressBar1.Position := ProgressBar1.Min;

  { Repinta a StatusBar para forçar a atualização visual }

  StatusBar1.Repaint;

end;

Execute e clique no botão para ver o resultado.

Colocar os bitmaps na DLL

 Por vezes, quando iniciamos um projeto, temos uma preocupação: fazer uma aplicação pequena em delphi. Bem, a solução pode passar por colocar todos os bitmaps que vamos utilizar numa DLL. Então vamos lá começar:

Deve usar o Image Editor, criar uma nova Resource File (.res), neste ficheiro vamos colocar os bitmaps e icons (ambos funcionam da mesma forma) que queremos na nossa aplicação, clique com a tecla direita do mouse na nova resource file e crie um novo bitmap, depois desenhe ou cole do clipboard um bitmap, finalmente guarde o ficheiro com o nome images.res. Depois disto estar feito vá ao IDE do Delphi e no File menu clique New... e escolha DLL depois cole o código abaixo, não se esqueça de adicionar uma unit vazia ao projeto. Guarde o projeto da dll no mesmo diretório do ficheiro image.res, finalmente faça o build da DLL (não se esqueça, que não se pode correr (executar) uma DLL!)

Código da DLL:

library ImageRes; {nome da dll}

uses DummyUnit; {DummyUnit é uma unit vazia, que é necessária}

{$R images.res} {nome da resource file, que deve estar no mesmo caminho da dll}

begin

end.

Código da DummyUnit:

unit DummyUnit;

interface

implementation

end.

Colocando bitmaps num ComboBox

Ajuste a propriedade Style do ComboBox para csOwnerDrawVariable

var

  Form1: TForm1;

  Bmp1, Bmp2, Bmp3: TBitmap;

implementation

 {$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

    Bmp1:=TBitmap.Create;

    Bmp.Loadfromfile('c:\chip16.bmp');

    Bmp1:=TBitmap.Create;

    Bmp.Loadfromfile('c:\zoom.bmp');

    Bmp1:=TBitmap.Create;

    Bmp.Loadfromfile('c:\disk.bmp');

    ComboBox1.Items.AddObject('Chip',Bmp1);

    ComboBox1.Items.AddObject('Zoom',Bmp2);

    ComboBox1.Items.AddObject('Disk',Bmp3);

end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOWnerDrawState);

var

  Bitmap: TBitmap;

  Offset: Integer;

begin

  with (Control as TComboBox).Canvas do

  begin

      FillRect(Rect); Bitmap:= TBitmap(ComboBox1.Items.Objects[index]);

      if Bitmap nil then begin

        BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,

        Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);

        Offset: Bitmap.width + 8;

      end;

      TextOut(Rect.Left + Offset, Rect.Top, ComboBox1.Items[index]);

  end;

end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);

begin

  Height:=20;

end;