Tips dan Trik Delphi - Internet

function komajadititik(txt:string):string;
var i:byte;
    str, Tempstr : String;
begin
   i :=1;
   for i := 1 to length(txt) do
   begin
        str:= copy(txt,i,1);
        if str=',' then
        begin
           str:='.';
        end;
        tempstr := tempstr + str;
   end;
   Result := Tempstr;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var latitude, longitude : Double;
begin
     latitude := -7.980167;
     longitude := 112.667282;
     Edit1.text := 'https://www.google.com/maps/?q='+
                  komajadititik(FloatToStr(latitude)) +','+
                  komajadititik(FloatToStr(longitude));

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    ListBox1.Style := lbOwnerDrawVariable;
    ListBox1.ItemHeight := 20;

    ListBox1.Items.Add('Item 1');
    ListBox1.Items.Add('Item 2');
    ListBox1.Items.Add('Item 3');
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  drawRect: TRect;
begin
  with ListBox1.Canvas do
  begin
    FillRect(rect);

    drawRect.Left := rect.Left + 1;
    drawRect.Right := Rect.Left + 13;
    drawRect.Bottom := Rect.Bottom;
    drawRect.Top := Rect.Top;

    if odSelected in State then
      DrawFrameControl(Handle, drawRect, DFC_BUTTON, DFCS_BUTTONRADIO or DFCS_CHECKED)
    else
      DrawFrameControl(Handle, drawRect, DFC_BUTTON, DFCS_BUTTONRADIO);

    TextOut(15, rect.Top + 3, ListBox1.Items[Index]);
  end;
end;

uses Winsock;

procedure TForm1.FormCreate(Sender: TObject);
var
    wVersionRequested : WORD;
    wsaData : TWSAData;
begin
    wVersionRequested := MAKEWORD(1, 1);
    WSAStartup(wVersionRequested,wsaData);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    p : PHostEnt;
    s : array[0..128] of char;
    p2 : pchar;
begin
    {Get the computer name}
    GetHostName(@s, 128);
    p := GetHostByName(@s);
    Memo1.Lines.Add(p^.h_Name);
    {Get the IpAddress}
    p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
    Memo1.Lines.Add(p2);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     {Shut down WinSock}
     WSACleanup;
end;

function ColorToHtml(DColor:TColor):string;
var
tmpRGB : TColorRef;
begin
      tmpRGB := ColorToRGB(DColor);
      Result:=Format('#%.2x%.2x%.2x', [GetRValue(tmpRGB), GetGValue(tmpRGB), GetBValue(tmpRGB)]);
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
     if IsValidEmail(Edit1.Text) Then
     begin
          if Cek_Domain(Edit1.Text) Then
          begin
               ShowMessage('Email Benar');
          end else
          begin
               ShowMessage('Cek kembali email anda');
          end;
     end else
     begin
          ShowMessage('Email Salah');
     end;
end;

Function TForm3.Cek_Domain(const Nomor: string) : Boolean;
begin
     result := False;
      if (LowerCase(RightStr(Nomor,4)) ='.ac.id') or
             (LowerCase(RightStr(Nomor,6)) ='.go.id') or
             (LowerCase(RightStr(Nomor,3)) ='.asia') or
             (LowerCase(RightStr(Nomor,4)) ='.biz') or
             (LowerCase(RightStr(Nomor,4)) ='.name') or
             (LowerCase(RightStr(Nomor,4)) ='.id') or
             (LowerCase(RightStr(Nomor,4)) ='.tv') or
             (LowerCase(RightStr(Nomor,4)) ='.info') or
             (LowerCase(RightStr(Nomor,4)) ='.in') or
             (LowerCase(RightStr(Nomor,4)) ='.net') or
             (LowerCase(RightStr(Nomor,4)) ='.edu') or
             (LowerCase(RightStr(Nomor,4)) ='.sch.id') or
             (LowerCase(RightStr(Nomor,4)) ='.int') or
             (LowerCase(RightStr(Nomor,4)) ='.co') or
             (LowerCase(RightStr(Nomor,4)) ='.co.id') or
             (LowerCase(RightStr(Nomor,4)) ='.org') or
             (LowerCase(RightStr(Nomor,4)) ='.or.id') or
             (LowerCase(RightStr(Nomor,4)) ='.com') Then
          Begin
               result := True;
          End;
end;

function TForm3.IsValidEmail(const Value: string): boolean;
        function CheckAllowed(const s: string): boolean;
        var
          i: integer;
        begin
          Result:= False;
          for i:= 1 to Length(s) do
          begin
            // illegal char - no valid address
            if not (s[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.','+']) then
              Exit;
          end;
          Result:= True;
        end;
var
  i: integer;
  namePart, serverPart: string;
begin
    Result := False;

    i:= Pos('@', Value);
    if (i = 0) then
      Exit;

    if(pos('..', Value) > 0) or (pos('@@', Value) > 0) or (pos('.@', Value) > 0)then
      Exit;

    if(pos('.', Value) = 1) or (pos('@', Value) = 1) then
      Exit;

    namePart:= Copy(Value, 1, i - 1);
    serverPart:= Copy(Value, i + 1, Length(Value));
    if (Length(namePart) = 0)  or (Length(serverPart) < 5)    then
      Exit;                      // too short

    i:= Pos('.', serverPart);
    // must have dot and at least 3 places from end
    if (i=0) or (i>(Length(serverPart)-2)) then
      Exit;

    Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;

uses GIFImg;

procedure TForm1.Button1Click(Sender: TObject);
var
  MS : TMemoryStream;
  GIf: TGIFImage;
begin
     MS := TMemoryStream.Create;
     GIf := TGIFImage.Create;
     try
          IdHTTP1.get('http://www.google.com/intl/en_ALL/images/logo.gif', MS);
          Ms.Seek(0,soFromBeginning);
          Gif.LoadFromStream(MS);
          Image1.Picture.Assign(GIF);
     finally
          FreeAndNil(GIF);
          FreeAndNil(MS);
     end;
end;

Uses Wininet;

Function TForm3.online : boolean;
begin
     result := (InternetGetConnectedState(nil, 0))
end;

Procedure TForm3.Timer1Timer(Sender: TObject);
begin
     if online= true then
        Label1.Caption := 'Connect' else
        Label1.Caption := 'Not Connect';
end;

Mengirim email dari outlook berdasarkan data dari Delphi

var em_subject, em_body, em_mail: string;

begin
  em_subject := 'latiham mengirim email dari XE 10';
  em_body := 'Latihan pertama';
  em_mail := 'mailto:delphi.guide@about.com?subject=' + em_subject + '&body=' + em_body ;
  ShellExecute(Application.Handle, 'open', PChar(em_mail), nil, nil, SW_SHOWNORMAL);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
      html: TStrings;
      htmpart, txtpart: TIdText;
      bmppart: TIdAttachment;
      email: TIdMessage;
begin
      IDSMTP.Host := Trim(cmbhost.Text);
      IDSMTP.Port := StrToInt(EdtPort.Text);

      html := TStringList.Create();
      html.Add('Halloooooo kursusdelphi.com, saya inden kursus Pak');
      email := TIdMessage.Create(nil);
      email.From.Text := trim('saya@gmail.com');
      email.Subject := Trim(EdtSubject.Text);
      email.ContentType := 'multipart/mixed';
      email.Body.Assign(html);
      email.Recipients.EMailAddresses := Trim('info@kursusdelphi.com');

      txtpart := TIdText.Create(email.MessageParts);
      txtpart.ContentType := 'text/plain';
      txtpart.Body.Text := '';

      htmpart := TIdText.Create(email.MessageParts, html);
      htmpart.ContentType := 'text/html';

      try
          idSMTP.Connect();
          try
              idSMTP.Send(email);
              // ShowMessage('Sent');
          except
          on E: Exception do
              // ShowMessage('Failed: ' + E.Message);
          end;
      finally
          idSMTP.Disconnect();
          // email.Free();
          // html.Free();
      end;
      ShowMessage('Selesai');
end;

Uses Wininet;

function TForm1.IsConnected: Boolean;
const
  // Local system has a valid connection to the Internet, but it might or might
  // not be currently connected.
  INTERNET_CONNECTION_CONFIGURED = $40;

  // Local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_LAN = $02;

  // Local system uses a modem to connect to the Internet
  INTERNET_CONNECTION_MODEM = $01;

  // Local system is in offline mode.
  INTERNET_CONNECTION_OFFLINE = $20;

  // Local system uses a proxy server to connect to the Internet
  INTERNET_CONNECTION_PROXY = $04;

  // Local system has RAS installed.
  INTERNET_RAS_INSTALLED = $10;

var
  InetState: DWORD;
  hHttpSession, hReqUrl: HInternet;
begin
  Result:= InternetGetConnectedState(@InetState, 0);
  if (
    Result
    and
    (
      InetState and INTERNET_CONNECTION_CONFIGURED
        = INTERNET_CONNECTION_CONFIGURED)
    ) then
  begin
    // so far we ONLY know there's a valid connection. See if we can grab some
    // known URL ...
    hHttpSession:= InternetOpen(
      PChar(Application.Title), // this line is the agent string
      INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0
    );
    try
      hReqUrl:= InternetOpenURL(
        hHttpSession,
        PChar('https://www.kursusdelphi.com'{ the URL to check }),
        nil,
        0,
        0,
        0
      );
      Result := hReqUrl <> nil;
      InternetCloseHandle(hReqUrl);
    finally
      InternetCloseHandle(hHttpSession);
    end;
  end
  else
    if (
      InetState and INTERNET_CONNECTION_OFFLINE = INTERNET_CONNECTION_OFFLINE
    ) then
      Result := False; // we know for sure we are offline.
end;