Baca Servername,userdb,password,dbname dari UDL (Sql Server)

function ReadUdl(t:string):TStringList;
var str:string;
i:integer;
lst:TStringList;
begin
lst:=TStringList.create;
for i := 1 to length(t) do
begin
if (t[i]=’;’ ) and (i <> length(t)) then
begin
lst.Add(str);
str:=”;
end
else if i=length(t) then
begin
str:=str+t[i];
lst.Add(str);
end
else
str:=str+t[i];
end;
result:=lst;
end;

function ReadUDLParameter(FileUDL,cr:string):string;
var
hasil:TStringList;
I: Integer;
begin
hasil:=ReadUdl(FileUDL);
for I := 0 to hasil.Count -1 do
begin
if cr=ansileftstr(hasil[i],length(cr)) then
result:=(ansirightstr(hasil[i],length(hasil[i])-length(cr)-1));
end;
end;

//=======================Cara Pemakaian

With TIniFile.Create(POSGlobals.FICEDir+’POSLocal.UDL’) do begin
IniUDLLocal := ReadString(‘oledb’,’Provider’, ”);
Free;
end;

ServerName:=ReadUDLParameter(IniUDLLocal,’Data Source’);
UserDB    :=ReadUDLParameter(IniUDLLocal,’User ID’);
Password  :=ReadUDLParameter(IniUDLLocal,’Password’);
DBName    :=ReadUDLParameter(IniUDLLocal,’Initial Catalog’);

//=======================

Advertisement

Pencarian isi data & Fields dalam suatu database

Coding :

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, StdCtrls, ComCtrls, Grids, DBGrids, ExtCtrls;

type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
Qtable: TADODataSet;
QField: TADODataSet;
Edit1: TEdit;
Button1: TButton;
QtableName: TWideStringField;
Qtableobject_id: TIntegerField;
QFieldname: TWideStringField;
QFieldobject_id: TIntegerField;
QCari: TADODataSet;
ListBox1: TListBox;
Label1: TLabel;
Button2: TButton;
Animate1: TAnimate;
Label2: TLabel;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
ListBox2: TListBox;
ADODataSet1: TADODataSet;
Label3: TLabel;
Label4: TLabel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Panel1: TPanel;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
Label5: TLabel;
SQ: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var FieldNameParameter,sql:string;
begin

label3.Caption:=”;
label4.Caption:=”;
adodataset1.Close;

if edit1.Text=” then
begin
showmessage(‘Masukan Parameters pencarian’);
edit1.SetFocus;
abort;
end;
ListBox1.clear;
ListBox2.clear;
Animate1.Active:=true;
Animate1.Visible:=true;

if RadioButton4.Checked then
begin

QCari.close;
if RadioButton2.Checked then
begin
QCari.CommandText:=’select sys.schemas.name+”.”+sys.tables.name+” *** Fields ”+sys.columns.name+”***” as Name, ‘+
‘sys.tables.object_id,sys.schemas.name+”.”+sys.tables.name as Tabl,sys.columns.name as NameFild from sys.tables ‘+
‘inner join sys.schemas on sys.tables.schema_id=sys.schemas.schema_id  ‘+
‘inner join sys.columns on sys.tables.object_id= sys.columns.object_id  ‘+
‘where sys.columns.name=:name order by Name ‘;
Qcari.Parameters.ParamValues[‘name’]:=edit1.Text;
Qcari.open;
if QCari.recordcount>0 then
begin
QCari.first;
while not QCari.Eof do
begin
ListBox1.Items.Add(QCari.fieldbyname(‘name’).asstring);
ListBox2.Items.Add(‘select * from ‘+QCari.fieldbyname(‘tabl’).value);
QCari.Next;
end;
end;
end;

if RadioButton1.Checked then
begin
QCari.CommandText:=’select sys.schemas.name+”.”+sys.tables.name+” *** Fields ”+sys.columns.name+”***” as Name, ‘+
‘sys.tables.object_id,sys.schemas.name+”.”+sys.tables.name as Tabl,sys.columns.name as NameFild from sys.tables ‘+
‘inner join sys.schemas on sys.tables.schema_id=sys.schemas.schema_id  ‘+
‘inner join sys.columns on sys.tables.object_id= sys.columns.object_id  ‘+
‘where sys.columns.name like ‘+quotedstr(‘%’+edit1.text+’%’)+’ order by Name ‘;
Qcari.open;
if QCari.recordcount>0 then
begin
QCari.first;
while not QCari.Eof do
begin
ListBox1.Items.Add(QCari.fieldbyname(‘name’).asstring);
ListBox2.Items.Add(‘select * from ‘+QCari.fieldbyname(‘tabl’).value);
QCari.Next;
end;

end;
end;
end else
if RadioButton3.Checked then
begin

Qtable.close;
Qtable.open;
Qtable.first;
while not Qtable.Eof do
begin
QField.Close;
QField.Parameters.ParamValues[‘id’]:=Qtableobject_id.AsString;
QField.open;

QField.first;
while not QField.Eof do
begin
//===============================
if RadioButton2.Checked then
sql:=’select ‘+QFieldname.Value+’ from ‘+QtableName.AsString+’ where ‘+QFieldname.Value+’ = ‘+quotedstr(edit1.Text);
if RadioButton1.Checked then
sql:=’select ‘+QFieldname.Value+’ from ‘+QtableName.AsString+’ where ‘+QFieldname.Value+’ like ‘+quotedstr(‘%’+edit1.Text+’%’);

Qcari.Close;
Qcari.CommandText:=sql;
try
Qcari.open;
if Qcari.recordcount>0 then
begin
ListBox1.Items.Add(‘table : ‘+QtableName.AsString+’ *** Fields : ‘+QFieldname.Value+’***’);
if RadioButton2.Checked then
ListBox2.Items.Add(‘select * from ‘+QtableName.AsString+’ where ‘+QFieldname.Value+’=”’+edit1.Text+””);
if RadioButton1.Checked then
ListBox2.Items.Add(‘select * from ‘+QtableName.AsString+’ where ‘+QFieldname.Value+’ like ‘+quotedstr(‘%’+edit1.Text+’%’));
end;
except
end;
//    end;
//===============================
QField.next;
end;
//=============================
Qtable.next;
end;
end;
Animate1.Active:=false;
Animate1.Visible:=false;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var FICEini:string;
begin
Animate1.Active:=false;
Animate1.Visible:=false;

ADOConnection1.Connected := false;
ADOConnection1.ConnectionString := ‘FILE NAME=’+ExtractFilePath(Application.ExeName)+’pos.UDL’;

try
ADOConnection1.Connected := true;
except
showmessage(‘Can”t Connect DataBase, Contact your Administrator…’);
abort;
end;

end;

procedure TForm1.ListBox2Click(Sender: TObject);
var sql:string;
begin
sql:=ListBox2.Items.Strings[ListBox2.ItemIndex];
label3.Caption:=sql;
adodataset1.Close;
adodataset1.CommandText:=sql;
adodataset1.open;
label4.Caption:=’Jumlah Data yang ditemukan : ‘+inttostr(adodataset1.recordcount);

end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
ListBox2.ItemIndex:=ListBox1.ItemIndex;
ListBox2Click(Sender);
end;

end.

untuk mengetahui list database (Sql Server 2005)

–untuk mengetahui list database

select * from sys.databases

–untuk mengetahui list table
select * from sys.tables

–untuk mengetahui colums table
select * from sys.columns

–untuk mengetahui culumn dari sebuah table

select sys.columns.name from sys.columns
inner join sys.tables  on sys.columns.object_id=sys.tables.object_id
where sys.tables.name=’TableName’

Reverse String

//Function Reverse

function ReverseString(const s: string): string;
var
i, len: Integer;
begin
len := Length(s);
SetLength(Result, len);
for i := len downto 1 do
begin
Result[len – i + 1] := s[i];
end;
end;

Import data excel ke table

function TForm1.import(tab: Tadotable; Tablename,SFile: string): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
x, y, r: Integer;
begin
Result := False;
XLApp := CreateOleObject(‘Excel.Application’);
try
XLApp.Visible := False;
XLApp.Workbooks.Open(SFile); //open file
Sheet := XLApp.Workbooks[ExtractFileName(SFile)].WorkSheets[1];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;

x := 2; //number of row in excel start import
repeat
tab.Append;
for r := 1 to y do
begin
tab.Fields[r-1].AsString:= XLApp.Cells.Item[x, r].Value;
end;
r:=1; // don’t remove this value, to keep value columns
tab.Post;
Inc(x, 1);
until XLApp.Cells.Item[x, r].Value=”;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var tablename,exttable:string;
begin
if OpenDialog1.Execute then
begin
tablename:=ExtractFileName(OpenDialog1.filename);
exttable:=ExtractFileExt(OpenDialog1.filename);
tablename:=trim(copy(tablename,1,length(tablename)-length(exttable)));

table1.TableName:=tablename;
table1.open;
if import(table1,tablename,OpenDialog1.filename) then
begin
table1.close;
table1.open;
ShowMessage(OpenDialog1.filename+’ has been imported!’);
end;
end;
end;

Get Username dan Computername

procedure TForm1.Button5Click(Sender: TObject);
var
buffer : array[0..255] of char;
size : dword;
UserName: String;
ComputerName: String;
begin
size := 256;
GetUserName(buffer, size);
UserName := buffer;
size := MAX_COMPUTERNAME_LENGTH + 1;
GetComputerName(buffer, size);
ComputerName := buffer;
ShowMessage(‘User Name: ‘+UserName+’ Computer Name: ‘+ComputerName);

end;

Menghitung jumlah kata

function TForm1.CountWords(InputString: string): integer;
var
aChar: char;
WordCount: integer;
IsWord: boolean;
i: integer;
begin
WordCount := 0;
IsWord := False;
for i := 0 to Length(InputString) do
begin
aChar := InputString[i];
if (aChar in [
‘a’,’b’,’c’,’d’,’e’,’f’,’g’,’h’,’i’,’j’,’k’,’l’,’m’,’n’,’o’,’p’,’q’,’r’,’s’,
‘t’,’u’,’v’,’w’,’x’,’y’,’z’,
‘A’,’B’,’C’,’D’,’E’,’F’,’G’,’H’,’I’,’J’,’K’,’L’,’M’,’N’,’O’,’P’,’Q’,’R’,’S’,
‘T’,’U’,’V’,’W’,’X’,’Y’,’Z’,
‘0’,’1′,’2′,’3′,’4′,’5′,’6′,’7′,’8′,’9′,’0′,””,’-‘
]) then
begin
if not IsWord then Inc(WordCount);
IsWord := True;
end
else if aChar = ‘\’ then IsWord := True
else IsWord := False

end;

IsWord := False;
Result := WordCount;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(inttostr(CountWords(edit1.Text)));
end;

Mengubah Resolusi Monitor

function TForm1.SetResolution(width, Height : integer) : Longint;
var DeviceMode: TDeviceMode;
begin
with DeviceMode do begin
dmSize := SizeOf(TDeviceMode);
dmPelsWidth := Width;
dmPelsHeight:= Height;
dmFields    := DM_PELSWIDTH or DM_PELSHEIGHT;
end;
result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
SetResolution(800,600);
end;

Menampilkan list file dengan ftp

//Function List File dari Ftp, memakai TIdFTP component TIndy

function TForm1.ListFileFromFTP: boolean;
var
i: integer;
ListaFTP: TStringList;
Path, PathLocal: string;
begin
result := False;
ListaFTP := TStringList.Create;

try
ftp.Host:=’192.168.7.109′;
ftp.Username:=’Hartono’;
ftp.Password:=’123456789′;
ftp.Port := 21;
ftp.Passive := true;
ftp.Connect;

Path :=”;

FTP.ChangeDir(Path);
FTP.TransferType := ftASCII;
FTP.List( ListaFTP, ”, False );
FTP.TransferType := ftBinary;

for i := 0 to ListaFTP.Count – 1 do
begin
ListBox1.Items.Add(ListaFTP.Strings[i]);
end;

result := True;

finally
FTP.Disconnect;
ListaFTP.Free;
end;
end;

//Pemanggilan Function

procedure TForm1.Button2Click(Sender: TObject);
var flag:boolean;
begin
flag:=ListFileFromFTP;
end;

Menampilkan List File dengan FTP

Function List File dengan Ftp, memakai component TIdFTP punya Indy Component

function TForm1.ListFileFromFTP: boolean;
var
i: integer;
ListaFTP: TStringList;
Path, PathLocal: string;
begin
result := False;
ListaFTP := TStringList.Create;

try
ftp.Host:=’192.168.7.109′;
ftp.Username:=’Hartono’;
ftp.Password:=’123456789′;
ftp.Port := 21;
ftp.Passive := true;
ftp.Connect;

Path :=”;

FTP.ChangeDir(Path);
FTP.TransferType := ftASCII;
FTP.List( ListaFTP, ”, False );
FTP.TransferType := ftBinary;

for i := 0 to ListaFTP.Count – 1 do
begin
ListBox1.Items.Add(ListaFTP.Strings[i]);
end;

result := True;

finally
FTP.Disconnect;
ListaFTP.Free;
end;
end;

Pemanggilan Procedure

procedure TForm1.Button2Click(Sender: TObject);
var flag:boolean;
begin
flag:=ListFileFromFTP;
end;