Programlama yapalım ve Öğrenelim.

SİLER İÇİN GENEL

function SetP(DbP:Integer):BOOLEAN;

var

i:integer;

s:string;

begin

i:=0;

s:='';

if F_DM=Nil then Application.CreateForm(TF_DM, F_DM);

_DBPointer:=DbP;

if Dbp>0 then

begin

_Connected:=TDatabase(DbP).Connected;

if (_Connected) then

begin

F_DM.Q1.DataBaseName:=TDatabase(DbP).DatabaseName;

_LoginServerDateTime:=ServerSaati(F_DM.Q1);

i:=1;

end;

Result:=True;

end;

function Connect(SName,DName,UName,Pd:String):String;

var

DbObj:TDatabase;

begin

if SName='' then

begin

Result:='MS-SQL SERVER adı girilmemiş !';

Exit;

end;

F_DM.Q1.Close;

F_DM.Q2.Close;

if _DbPointer=0 then

begin

F_DM.Q1.DataBaseName:='DB';

F_DM.Q2.DataBaseName:='DB';

DbObj:=F_DM.DB1;

end

else

begin

DbObj:=TDatabase(_DbPointer);

F_DM.Q1.DataBaseName:=DbObj.DatabaseName;

F_DM.Q2.DataBaseName:=DbObj.DatabaseName;

end;

with DbObj do

begin

Close;

begin

DriverName:='MSSQL';

Params.Clear;

Params.Add('DATABASE NAME='+DName);

Params.Add('SERVER NAME='+SName);

Params.Add('OPEN MODE=READ/WRITE');

Params.Add('SCHEMA CACHE SIZE=8');

Params.Add('BLOB EDIT LOGGING=');

Params.Add('LANGDRIVER=ANTURK');

Params.Add('SQLQRYMODE=');

Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');

Params.Add('DATE MODE=0');

Params.Add('SCHEMA CACHE TIME=-1');

Params.Add('MAX QUERY TIME=300');

Params.Add('MAX ROWS=-1');

Params.Add('BATCH COUNT=200');

Params.Add('ENABLE SCHEMA CACHE=FALSE');

Params.Add('SCHEMA CACHE DIR=');

Params.Add('HOST NAME=');

Params.Add('APPLICATION NAME=');

Params.Add('NATIONAL LANG NAME=');

Params.Add('ENABLE BCD=FALSE');

Params.Add('TDS PACKET SIZE=4096');

Params.Add('BLOBS TO CACHE=64');

Params.Add('BLOB SIZE=32');

Params.Add('USER NAME='+UName);

Params.Add('PASSWORD='+Pd);

end;

try

Open;

Result:='';

_Connected:=True;

_LoginServerDateTime:=ServerSaati(F_DM.Q1);

except

Result:='Veritabanına bağlanamadı !';

_Connected:=False;

end;

end;//with ...

end;

function Set_ShowP(SPD:Boolean):Boolean;

begin

_ShowP:=SPD;

Result:=True;

end;

procedure _Goster_Finish();

begin

F_DM.Free;

end;

// tablo oluşturma başı

function KolonTipi(Tipi:String;GirisTipi,CikisTipi:Integer):String;

const

hesapla:array[1..24,1..2] of String=

(

('bit','Number(1)'),

('int','Number(10)'),

('smallint','Number(6)'),

('tinyint','Number(4)'),

('money','Number(*)'),

('smallmoney','Number(*)'),

('float','Number(*)'),

('real','Number(*)'),

('datetime','Date'),

('smalldatetime','Date'),

('cursor','???'),

('timestamp','Date'),

('uniqueidentifier','???'),

('text','LONG'),

('ntext','LONG'),

('image','LONG RAW'),

('char','Char'),

('varchar','Varchar2'),

('nchar','Char'),

('nvarchar','VarChar2'),

('binary','VarChar2'),

('varbinary','VarChar2'),

('decimal','Number'),

('numeric','Number')

);

var

i:Integer;

durum:boolean;

begin

Durum:=true;

Result:=Tipi;

if GirisTipi=CikisTipi then

begin

durum:=false;

Exit;

end;

for i:=1 to 24 do if UpperCase(hesapla[i,GirisTipi])=UpperCase(Tipi) then

begin

Result:=hesapla[i,cikisTipi];

Break;

end;

function TipSayisi(TipAdi:String):Integer;

const

Tipler:array[1..24] of String=

(

'bit','int','smallint','tinyint','money','smallmoney',

'float','real','datetime','smalldatetime','cursor',

'timestamp','uniqueidentifier','text','ntext','image',

'char','varchar','nchar','nvarchar','binary','varbinary',

'decimal','numeric'

);

var

i:Integer;

durum:boolean;

begin

durum:=false;

Result:=-1;

for i:=1 to 24 do if Tipler[i]=TipAdi then break;

if i>22 then Result:=2 else if i<17 then

begin

Result:=0;

durum:=false;

end

else

begin

Result:=1;

durum:=true;

end;

function

TableScriptOlustur(Q:TQuery;User,TabloAdi:String;GirisTipi,CikisTipi:Integer):String;

var

ML:String;

S,ColT:String;

t:integer;

durum:boolean;

Prc,Scl:String;

Iden:String;

SatirSonu:String;

TABLO2:STRING;

begin

TABLO2:=COPY(TABLOADI,17,200);

durum:=false;

Q.Close;

t:=0;

S:='';

Iden:='IDENTITY (1,1) ';

SatirSonu:='/*;*/';

Q.SQL.Text:=' select sys1.Name Sys1Name, sys1.Length, sys1.xPrec,

sys1.xScale,'+

' sys1.isNullable,sys1.ColStat, sys2.Name Sys2Type, sys3.Text '+

' from syscolumns sys1, systypes sys2,'+

' syscomments sys3, sysobjects sys4, sysusers sys5 '+

' where sys1.id=sys4.id '+

' and sys2.xType=sys1.xType '+

' and sys1.CDefault*=sys3.id '+

' and sys4.uid=sys5.uid '+

' and sys4.name='+_S(TABLO2)+

' and sys5.Name='+_S(User)+

' order by sys1.ColOrder ';

Q.Open;

Q.First;

if Q.RecordCount>0 then

begin

durum:=true;

end;

S:='create table '+Tabloadi+#13#10

+'('+#13#10;

Q.First;

while not Q.EOF do

begin

ColT:=KolonTipi(Q.FieldByName('Sys2Type').AsString,GirisTipi,CikisTipi);

ML:=' '+Q.FieldByName('Sys1Name').AsString+#9#9+ColT+' ';

if TipSayisi(Q.FieldbyName('Sys2Type').Value)=0 then

begin

if (Q.FieldbyName('ColStat').Value=1) then ML:=ML+Iden;

end;

if TipSayisi(Q.FieldbyName('Sys2Type').Value)=1 then

begin

ML:=ML+'('+Q.FieldbyName('Length').AsString+') ';

end;

if TipSayisi(Q.FieldbyName('Sys2Type').Value)=2 then

begin

Prc:=Q.FieldbyName('xPrec').AsString;

Scl:=Q.FieldbyName('xScale').AsString;

if (Prc='') and (Scl='') then ML:=ML+'(*) '

else if Scl='0' then ML:=ML+'('+Prc+') '

else ML:=ML+'('+Prc+','+Scl+') ';

end;

if Q.FieldbyName('Text').AsString='' then

begin

if Q.FieldbyName('IsNullable').AsInteger=1 then ML:=ML+'NULL '

else ML:=ML+'NOT NULL ';

end else ML:=ML+'DEFAULT '+Q.FieldbyName('Text').AsString+' ';

Q.Next;

if Q.EOF then S:=S+ML+#13#10')'+SatirSonu+#13#10 else S:=S+ML+','+#13#10;

end;//while not ...

Q.Close;

Result:=S;

end;

function

IndexScriptOlustur(Q:TQuery;User,Tabloadi:String;GirisTipi,CikisTipi:Integer):String;

var IndexID:Integer;

L:Integer;

IndexName:String;

durum:boolean;

t:integer;

ML,MF:String;

S:String;

SatirSonu:String;

TABLO2:STRING;

begin

TABLO2:=COPY(TABLOADI,17,200);

durum:=false;

t:=1;

Q.Close;

Delphi - .....................................

SİZLER İÇİN GENEL1

unit MyUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, DBTables, Db, Math,

Mask, dxDateEdit, dxDBDateEdit,ShellAPI,

Menus, Buttons,IniFiles,CheckLst,dxDBGrid,MDSElps,

ComCtrls,

dxCntner,

dxTL, ExtCtrls, ImgList;

type

TY=Record

Islem:WORD;

Yetki:BYTE;

end;//TY

TYetki=record

Count:Integer;

Y:array[0..1000] of TY;

end;

Procedure YedekAl;

procedure MenuDegistir(Menu:Tmenuitem; Rap_ID:integer);

function MDSRound(sayi:Extended;tip:integer;Ondalik:integer):Extended;

function _YaziIng(Sayi:Extended):String;

function MdsReplace(s:string;ch1:char;ch2:char):string; //ch1 aralnılacak

karekter. ch2 yerine konacak karekter

procedure KilitEkle;

procedure YTLModulleriOku;

procedure FIFO(FIFO_STOKID:integer;Hareket_Tarihi:TdateTime;

Donem_Bas_Tar:TdateTime; Donem_Bit_Tar:TdateTime);

procedure KilitSil1(TABLO_ADI:string;KAYIT_ID:integer);//muhasebe ve kartlarda

kullanmak için

procedure KilitSil2(TABLO_ADI:string;AY:integer;YIL:integer);//BORDRO'da

kullanmak için

//eğer kullanılıyorsa kilitKontrol1 false (kayıt yapılamaz)

// eğer kullanılmıyorsa kilitKontrol1 true (kayıt yapılabilir)

function KilitKontrol1(TABLO_ADI:string;KAYIT_ID:integer):boolean;//muhasebe

ve kartlarda kullanmak için

function ExecFile(const MainFormHandle:HWND;FileName, Params, DefaultDir:

string;

ShowCmd: Integer): THandle;

//eğer kullanılıyorsa kilitKontrol2 false (kayıt yapılamaz)

// eğer kullanılmıyorsa kilitKontrol2 true (kayıt yapılabilir)

function

KilitKontrol2(TABLO_ADI:string;AY:integer;YIL:integer):boolean;//BORDRO'da

kullanmak için

function ServerSaati(Q:TQuery):TDateTime;

procedure _Goster_Finish();

function SetP(DbP:Integer):BOOLEAN;

function Connect(SName,DName,UName,Pd:String):String;

function Set_ShowP(SPD:Boolean):Boolean;

function

TableScriptOlustur(Q:TQuery;User,Tabloadi:String;GirisTipi,CikisTipi:Integer):String;

function

IndexScriptOlustur(Q:TQuery;User,Tabloadi:String;GirisTipi,CikisTipi:Integer):String;

function

ViewScriptOlustur(Q:TQuery;User,Viewadi:String;GirisTipi:Integer):String;

function

ProcScriptOlustur(Q:TQuery;User,Procadi:String;GirisTipi:Integer):String;

function

SequenceScriptOlustur(Q:TQuery;User,Tabloadi:String;GirisTipi:Integer):String;

function Rapor_Goster(RapoRId:Integer):String;

function _yazi(Nmbr:Extended):String;

function HesapOkuNet(s:string):integer; //stdcall;

function HesapOkuM4(s:string):integer; //stdcall;

function HLogin:Boolean; //net hasp için

function HLogOut:Boolean;

function TabloKontrol(Q:TQuery;TabloAdi,User:String):BOOLEAN;

function ViewKontrol(Q:TQuery;ViewAdi,User:String):BOOLEAN;

function ProcKontrol(Q:TQuery;ProcAdi,User:String):BOOLEAN;

function _S(S:String):String;

function _N(N:Extended):String;

function _D(D:TDateTime):String;

function ToUpper(Str:string):string;

function ToLower(Str:string):string;

function Upper(chr1:char):char;

function Lower(chr1:char):char;

function BankaHesapKontrol(BANKA_HESAP_ID:integer; Q1:TQuery):integer; //1

function KasaHesapKontrol(KASA_ID:integer; Q1:TQuery):integer; // 1

function CariHesapKontrol(CARI_ID:integer; Q1:TQuery):integer; // 1

function DemirbasHesapKontrol(DEMIRBAS_ID:integer; Q1:TQuery):integer; // 9

function StokHesapKontrol(STOK_ID:integer; Q1:TQuery):integer; // 12

function HizmetHesapKontrol(HIZMET_ID:integer; Q1:TQuery):integer; //10

function CSKasaHesapKontrol(CS_KASA_ID:integer; Q1:TQuery):integer; //12

function PersonelHesapKontrol(PERSONEL_ID:integer; Q1:TQuery):integer; //15

//***

procedure inikaydet;

procedure iniSil;

function inibul:boolean;

procedure inioku;

function Maskele(Tip:ShortInt; ms, Maske:String):String;

function Mesaj(S:String;MB,tip:UINT):Integer;

function BoslukSil(S:String):String;

procedure DepoDoldur(CL_List: TCheckListBox);

procedure MeslekDoldur(CL_List: TCheckListBox);

procedure BolumDoldur(CL_List: TCheckListBox);

procedure GorevDoldur(CL_List: TCheckListBox);

procedure FinansEk1Doldur(CL_List: TCheckListBox);

procedure FinansEk2Doldur(CL_List: TCheckListBox);

procedure CariEk1Doldur(CL_List: TCheckListBox);

procedure CariEk2Doldur(CL_List: TCheckListBox);

procedure MuhasebeEk1Doldur(CL_List: TCheckListBox);

procedure MuhasebeEk2Doldur(CL_List: TCheckListBox);

procedure MasrafEk1Doldur(CL_List: TCheckListBox);

procedure MasrafEk2Doldur(CL_List: TCheckListBox);

procedure StokEk1Doldur(CL_List: TCheckListBox);

procedure StokEk2Doldur(CL_List: TCheckListBox);

procedure StokHarEk1Doldur(CL_List: TCheckListBox);

procedure StokHarEk2Doldur(CL_List: TCheckListBox);

procedure DemirbasEk1Doldur(CL_List: TCheckListBox);

procedure DemirbasEk2Doldur(CL_List: TCheckListBox);

function Encrypt(S:String):String;

function Decrypt(S:String):String;

function AQ(s:STRING):STRING;

//------------------------------------------

procedure

ShowMenu(Q1:TQuery;Menu1:TMenuItem;Menu2:TMenuItem;Menu3:TMenuItem;Menu4:TMenuItem;

R_id:integer);

procedure showpopup(btn:TBitBtn;p:TPopupMenu);

procedure showpopupSB(sb:TSpeedButton;p:TPopupMenu);

procedure DBConnect;

function KodMaskesiBul(Q1:TQuery;ModulID:integer;Seviye:integer):string;

procedure AllCheck(CL_List: TCheckListBox); //CheckListBox'daki item'ları

seçili hale getirmek için

procedure AllNotCheck(CL_List: TCheckListBox); //CheckListBox'daki item'ların

seçimini iptal etmek için

procedure

CheckDownClick(CL_List:TCheckListBox;SB_Check:TSpeedButton;SB_NotCheck:TSpeedButton);//ComboCheckListBox

Down Click

procedure CheckExit(CL_List:

TCheckListBox;SB_Check:TSpeedButton;SB_NotCheck:TSpeedButton);//Onexit'a

yazılacak...

procedure SagdakiSutunaGit(DxGrid:TdxDBGrid);

function EK_Tanim1Oku(Q:TQuery):integer;

function YetkiOku(Q:TQuery;ISLEM_ID:integer):String;

function KullaniciOku(Q:TQuery;Modul:string;K_id:integer):String;

function GetMeslekID(CL_List: TCheckListBox):string;

function GetGorevID(CL_List: TCheckListBox):string;

function GetBolumID(CL_List: TCheckListBox):string;

function GetStokGirisCikis(CL_List: TCheckListBox):string;

function GetDepoID(CL_List: TCheckListBox):string;

procedure MM_TipiBul;

function HesapYetkiOku(Kod:string):string;//Ekrana bilgi aktarmak için

procedure HesapYetkiOndeger;

function IslemGunuBul(ModulID:integer):integer; // 1 Muhasebe, 2 Bordro, 3

Demirbaş, 4 Finans, 5 Stok

const

FIRMA0='F00000';

PSW:String='4793';

DATABASE_NAME:String='medadata';

SERVER_NAME:String='IZOS';

DB_USER_NAME:String='F00000';

_WinPath:string='c:windows';

RapT:integer=1;

karekter:array[0..9] of

extended=(1,0.1,0.01,0.001,0.0001,0.00001,0.000001,0.0000001,0.00000001,0.000000001);

A20 : Array[1..19] Of

String=('One','Two','Three','Four','Five','Six','Seven','Eight','Nine',

'Ten','Eleven','Twelve','Thirteen','Fourteen','Fifteen','Sixteen',

'Seventeen','Eighteen','Nineteen');

A10 : Array[1..9] Of

String=('Ten','Twenty','Thirty','Forty','Fifty','Sixty','Seventy','Eighty','Ninety');

EKS = 1.00;

EBS = 999999999999.99;

* A list of the HASP services

IS_HASP = 1;

GET_HASP_CODE = 2;

READ_MEMO = 3;

WRITE_MEMO = 4;

GET_HASP_STATUS = 5;

GET_ID_NUM = 6;

READ_MEMO_BLOCK = 50;

WRITE_MEMO_BLOCK = 51;

ENCODE_DATA = 60;

DECODE_DATA = 61;

MEMO_INCORRECT_PASSWORD = -3;

LPT_IBM_ALL_HASP25 = 0;

LPT_IBM_ALL_HASP36 = 50;

LPT_NEC_ALL_HASP36 = 60;

ENC_DEC_BUFFER_SIZE = 4096;

MEMO_BUFFER_SIZE = 248;

TIME_BUFFER_SIZE = 16; (* TimeHASP maximum block size *)

* A list of the TimeHASP services

TIMEHASP_SET_TIME = 70;

TIMEHASP_GET_TIME = 71;

TIMEHASP_SET_DATE = 72;

TIMEHASP_GET_DATE = 73;

TIMEHASP_WRITE_MEMORY = 74;

TIMEHASP_READ_MEMORY = 75;

TIMEHASP_WRITE_MEMORY_BLOCK = 76;

TIMEHASP_READ_MEMORY_BLOCK = 77;

TIMEHASP_GET_ID_NUM = 78;

TIME_INCORRECT_PASSWORD =-28;

* A list of NetHASP services.

NET_LAST_STATUS = 40;

NET_GET_HASP_CODE = 41;

NET_LOGIN = 42;

NET_LOGOUT = 43;

NET_READ_WORD = 44;

NET_WRITE_WORD = 45;

NET_GET_ID_NUMBER = 46;

NET_SET_IDLE_TIME = 48;

NET_READ_MEMO_BLOCK = 52;

NET_WRITE_MEMO_BLOCK = 53;

NET_ENCODE_DATA = 88;

NET_DECODE_DATA = 89;

NET_READ_ERROR = 131;

NET_WRITE_ERROR = 132;

* Error Codes

OK = 0;

DATA_TOO_SHORT = -7;

HARDWARE_NOT_SUPPORTED = -8;

INVALID_POINTER = -9;

* Error Strings

STR_DATA_TOO_SHORT = 'Data to Encode/Decode is too short.';

STR_HARDWARE_NOT_SUPPORTED = 'Not a Marvin plug.';

STR_INVALID_POINTER = 'Buffer pointer is invalid.';

STR_ENCODE_SUCCEEDED = 'Encode Data OK.';

STR_DECODE_SUCCEEDED = 'Decode Data OK.';

NO_HASP = 'HASP plug not found !';

* Global variables.

var

hp_tur:integer; //1=net, 2=m1

ddd:boolean; // demo kontrolü için kullanılıyor

bbb:integer; //5 ise işlem yap

HesapYetkiKontrol:integer;//0 ise kontrol yok , 1 ise kontrol et;

OLUSTURAN:integer;

DEGISTIREN:integer;

OLUS_TAR:tdate;

DEGIS_TAR:tdate;

c_Tag2:integer;

sira_no2:string;

c_Tag1:integer;

sira_no1:string;

Z_Ek_Tanim1:integer;//1 zorunlu , 0 değil

KullaniciID:Integer;

KullaniciAdi:String;

KullaniciAdiSoyadi:String;

KullaniciAdiSoyadi2:String;

DonemYili:string;

FirmaID:integer;

MY_HESAP_KODU:STRING;

_Connected:Boolean;

_LoginServerDateTime:TDateTime;

DonemAdi:String;

Donem:String;

DonemBasTar:TDateTime;

DonemBitTar:TDateTime;

Yetkiler:TYetki;

_SQL:array[1..3] of String;

_SabitDegerler:String;

_DbPointer:LongInt=-1;

_DevT:Integer=1;

_ShowP:Boolean=True;

_RapSec:Integer;

MuhasebeIsleteme:integer;

FirmaKodu:string;

FirmaKodu1:string[6];

Donem_Adi:String;

Firma_Uzun_Adi:string;

FirmaID1:integer;

Donem_BasTar:string;

Donem_BitTar:string;

Firma_Adi:String;

Meda: TIniFile; //ini file

FileToFind: string; // bulunan ini file 'ın yolu

USER_NAME:String;

HesapKodu:string;

HesapAdi:String;

KullaniciID1:integer;

F_Tag:integer;

masraf_merkezi_tipi:integer;//2 ise çok satırlı anlamında

CH_BOLUM_ID :ARRAY [0..50] OF integer;

CH_GOREV_ID :ARRAY [0..50] OF integer;

CH_MESLEK_ID :ARRAY [0..50] OF integer;

CH_DEPO_ID :ARRAY [0..50] OF integer;

Muhasebe_Gun:integer;

Bordro_Gun:integer;

Demirbas_Gun:integer;

Finans_Gun:integer;

Stok_Gun:integer;

LptNum ,SeedCode : longint;

Pass1 : longint;

Pass2 : longint;

p1,p2,p3,p4 : longint;

Service : longint;

ID : longint;

i : integer;

HaspMemoBuff : array[1..MEMO_BUFFER_SIZE] of word ;

TimeHaspMemoBuff : array[1..TIME_BUFFER_SIZE] of byte ;

EncDecBuff : array[1..ENC_DEC_BUFFER_SIZE] of byte;

TmpBuff : array[1..8] of byte;

ProductType : integer;

type

TKilit=record

KILIT_ID:integer;

MODUL:string[20];

TABLO_ADI:string[50];

KAYIT_ID:integer;

AY:integer;

YIL:integer;

GUN:integer;

YEDEK1:integer;

YEDEK2:integer;

KULLANICI_ID:integer;

KULLANICI_ADI:string[40];

TARIH_SAAT:tdate;

ACIKLAMA:string[100];

end;//tkilit

const

MsgUyari=MB_ICONEXCLAMATION;

MsgHata=MB_ICONSTOP;

MsgBilgi=MB_ICONINFORMATION;

MsgSoru=MB_ICONQUESTION;

var

MyEdit:TEdit;

YTLFinans:integer;

YTLBordro:integer;

YTLStok:integer;

YTLDemirbas:integer;

SQLStr1, SQLStr2, SQLStr3,SQLStr4,SQLStr5:String;

BagKodu:Integer;

kilit:tkilit;

type

TF_MyUnit = class(TForm)

Label1: TLabel;

PM_Gonder: TPopupMenu;

MI_TextO: TMenuItem;

TO1: TMenuItem;

TO2: TMenuItem;

MI_GrafikO: TMenuItem;

G01: TMenuItem;

G02: TMenuItem;

N1: TMenuItem;

MI_TextD: TMenuItem;

TD1: TMenuItem;

TD2: TMenuItem;

MI_GrafikD: TMenuItem;

GD1: TMenuItem;

GD2: TMenuItem;

N2: TMenuItem;

MI_Excel: TMenuItem;

MI_HTML: TMenuItem;

SD1: TSaveDialog;

M_RaporKontrolleri: TMemo;

M_RaporListBoxlari: TMemo;

db2: TDatabase;

IL_TOOLBAR: TImageList;

Q1: TQuery;

MyDatabase2: TDatabase;

Q5: TQuery;

procedure medasa_connect;

function FormGoster(FormTipi:TFormClass;var Form;Count:Integer):Integer;

procedure AcikPencereleriKapat;

private

{ Private declarations }

public

{ Public declarations }

end;

var

F_MyUnit: TF_MyUnit;

implementation

uses RaporDM, DM, RapLogin, Onizleme2 ;

{$R *.DFM}

procedure hasp ( Service,

SeedCode,

LptNum,

Pass1, Pass2 : longint;

var p1, p2, p3, p4 : longint);

stdcall;

external 'haspms32.dll';

function Check_Hasp:Boolean;

begin

Pass1:=21327;

Pass2:=22518;

Check_Hasp := True;

Service := IS_HASP;

hasp ( Service, SeedCode, LptNum, Pass1, Pass2, p1, p2, p3, p4 );

if ( p1 = 0 ) then

begin

// mesaj :='No HASP key was found.';

Check_Hasp := False;

end

end;

Function Is_MemoHASP :Boolean;

begin

Is_MemoHASP := True;

Service := GET_HASP_STATUS;

hasp(Service, SeedCode, LptNum, Pass1, Pass2, p1, p2, p3, p4);

if (p2 = 3) or ((p2 = 0) and (p3 <> 0)) Then

begin

// mesaj := 'Not a MemoHASP.';

Is_MemoHASP := False;

end

end;

Function Is_HASP4 :Boolean;

var

i: integer;

tmpP1, tmpP2, tmpP3, tmpP4: integer;

begin

Is_HASP4 := True;

for i := 1 to 8 do

TmpBuff[i] := 0;

asm

mov tmpP4, Offset TmpBuff

end;

tmpP1 := 0;

tmpP2 := 8;

tmpP3 := 0;

Service := ENCODE_DATA;

hasp(Service, SeedCode, LptNum, Pass1, Pass2, tmpP1, tmpP2, tmpP3, tmpP4);

if (tmpP3 = HARDWARE_NOT_SUPPORTED) Then Is_HASP4 := False;

end;

function HesapOkuNet(s:string):integer; // stdcall;

var

a1,a2,a3,a4:integer;

begin

Pass1:=21327;

Pass2:=22518;

LptNum :=1;// LPT_IBM_ALL_HASP25;

SeedCode:=300;

result:=-1;

// if Check_Hasp = False then exit;

// if Is_MemoHASP = False then exit;

Service := NET_READ_WORD;

Screen.Cursor := crHourGlass;

p1 := StrToInt(s); {Address}

p2 := 0;

hasp ( Service,300{ SeedCode}, LptNum, Pass1, Pass2, p1, p2, p3, p4 );

{ Check the status }

Service := NET_LAST_STATUS;

hasp( Service, SeedCode, LptNum, Pass1, Pass2, a1,a2,a3,a4);

Screen.Cursor := crDefault;

result:=p2;

end; //HesapOku2

function HesapOkuM4(s:string):integer; // stdcall;

var

a1,a2,a3,a4:integer;

begin

Pass1:=21327;

Pass2:=22518;

LptNum :=LPT_IBM_ALL_HASP25;

SeedCode:=300;

result:=-1;

if Check_Hasp = False then exit;

if Is_MemoHASP = False then exit;

Service := READ_MEMO;

Screen.Cursor := crHourGlass;

p1 := StrToInt(s); {Address}

p2 := 0;

hasp ( Service,300{ SeedCode}, LptNum, Pass1, Pass2, p1, p2, p3, p4 );

Screen.Cursor := crDefault;

result:=p2;

end; //HesapOku2

Function HLogin:Boolean ; //net hasp için

var

a1,a2,a3,a4:integer;

begin

result:=false;

Pass1:=21327;

Pass2:=22518;

LptNum :=LPT_NEC_ALL_HASP36;//LPT_IBM_ALL_HASP36;// LPT_IBM_ALL_HASP25;

LptNum:=1;

SeedCode := 300; {default value}

Service := NET_LOGIN;

Screen.Cursor := crHourGlass;

hasp( Service, SeedCode, LptNum, Pass1, Pass2, p1, p2, p3, p4);

Service := NET_LAST_STATUS;

hasp( Service, SeedCode, LptNum, Pass1, Pass2, a1,a2,a3,a4);

Screen.Cursor := crDefault;

{ Check the status }

if a1 = OK then

begin

result:=true;

end;

function HLogOut:Boolean;

var

a1,a2,a3,a4:integer;

begin

result:=false;

Pass1:=21327;

Pass2:=22518;

LptNum := 1;//LPT_IBM_ALL_HASP25;

SeedCode:=300;

Service := NET_LOGOUT;

Screen.Cursor := crHourGlass;

hasp( Service, SeedCode, LptNum, Pass1, Pass2, p1, p2, p3, p4);

Service := NET_LAST_STATUS;

hasp( Service, SeedCode, LptNum, Pass1, Pass2, a1,a2,a3,a4);

Screen.Cursor := crDefault;

{ Check the status }

if a1 = OK then

begin

result:=true;

end;

function TabloKontrol(Q:TQuery;TabloAdi,User:String):BOOLEAN;

begin

Q.Close;

Q.SQL.Text:=' select sys1.name '+

' from sysobjects sys1,sysusers sys2 '+

' where sys1.uid=sys2.uid '+

' and sys1.xtype=''U'' '+//Table

' and sys2.name='+_S(User)+

' and sys1.name='+_S(Tabloadi);

Q.Open;

Result:=not Q.EOF;

Q.Close;

end;

function ViewKontrol(Q:TQuery;ViewAdi,User:String):BOOLEAN;

begin

Q.Close;

Q.SQL.Text:=' select sys1.name '+

' from sysobjects sys1,sysusers sys2 '+

' where sys1.uid=sys2.uid '+

' and sys1.xtype=''V'' '+//View

' and sys2.name='+_S(User)+

' and sys1.name='+_S(ViewAdi)+' ';

Q.Open;

Result:=not Q.EOF;

Q.Close;

end;

function ProcKontrol(Q:TQuery;ProcAdi,User:String):BOOLEAN;

begin

Q.Close;

Q.SQL.Text:=' select sys1.name '+

' from sysobjects sys1,sysusers sys2 '+

' where sys1.uid=sys2.uid '+

' and sys1.xtype=''P'' '+//procedure

' and sys2.name='+_S(User)+

' and sys1.name='+_S(ProcAdi);

Q.Open;

Result:=not Q.EOF;

Q.Close;

end;

function Upper(chr1:char):char;

begin

case chr1 of

'ç': chr1:='Ç';

'ş': chr1:='Ş';

'i': chr1:='İ';

'ö': chr1:='Ö';

'ğ': chr1:='Ğ';

'ü': chr1:='Ü';

'ı': chr1:='I';

end;

if (chr1>='a') and (chr1<='z') then

chr1:=chr(Ord(chr1)-$20);

result:=chr1;

end;//upper

function lower(chr1:char):char;

begin

case chr1 of

'Ç': chr1:='ç';

'Ş': chr1:='ş';

'İ': chr1:='i';

'Ö': chr1:='ö';

'Ğ': chr1:='ğ';

'Ü': chr1:='ü';

'I': chr1:='ı';

end;

if (chr1>='A') and (chr1<='Z') then

chr1:=chr(Ord(chr1)+$20);

result:=chr1;

end;//lower

function ToUpper(Str:string):string;

var

Uzunluk:integer;

i:integer;

begin

uzunluk:=length(str);

for i:=1 to uzunluk do

begin

str[i]:=Upper(str[i]);

end;

result:=str;

end;//toupper

function ToLower(Str:string):string;

var

Uzunluk:integer;

i:integer;

begin

uzunluk:=length(str);

for i:=1 to uzunluk do

begin

str[i]:=Lower(str[i]);

end;

result:=str;

end;//ToLower

function ServerSaati(Q:TQuery):TDateTime;

begin

Q.Close;

Q.SQL.Text:='select CURRENT_TIMESTAMP';

Q.Open;

Result:=Q.Fields[0].Value;

end;

function _S(S:String):String;

var j,L:Integer;

S2:String;

begin

S2:='';

L:=Length(S);

for j:=1 to L do

begin

S2:=S2+S[j];

if S[j]=#39 then S2:=S2+#39;

end;{for ...}

Result:=#39+S2+#39;

end;//_S

function _N(N:Extended):String;

begin

if DecimalSeparator<>'.' then DecimalSeparator:='.';

Result:=FloatToStr(N);

DecimalSeparator:=',';

end;//_N

function _D(D:TDateTime):String;

var S:String;

begin

if D>0 then

begin

S:=DateTimeToStr(D);

S:=#39+copy(S,4,3)+copy(S,1,3)+copy(S,7,255)+#39;

end//if D>0

else S:='NULL';

Result:=S;

end;//_D

Delphi - .....................................

SİZLER İÇİN GENEL2

//************ HESAP KONTROLLERİ

function BankaHesapKontrol(BANKA_HESAP_ID:integer;Q1:tQuery):integer;

var

s:string;

begin

s:='select isnull(HESAP_ID,0) HESAP_ID, isnull(MM_HESAP_ID,-1) MM_HESAP_ID'+

' from BANKA_HESAPLARI '+

' WHERE BANKA_HESAP_ID='+_N(BANKA_HESAP_ID)+

' AND isnull(HESAP_ID,0)>0 ';

Q1.Close;

Q1.SQL.Text:=s;

Q1.Open;

result:=Q1.RecordCount;

end;//BankaHesapBul;

function CariHesapKontrol(CARI_ID:integer; Q1:TQuery):integer;

var

s:string;

begin

s:='select isnull(HESAP_ID,0) HESAP_ID, isnull(MM_HESAP_ID,-1) MM_HESAP_ID '+

' from CARI '+

' WHERE CARI_ID='+_N(CARI_ID)+

' AND isnull(HESAP_ID,0)>0 ';

Q1.Close;

Q1.SQL.Text:=s;

Q1.Open;

result:=Q1.RecordCount;

end;//CariHesapBul;

function KasaHesapKontrol(KASA_ID:integer; Q1:TQuery):integer;

var

s:string;

begin

s:='select isnull(HESAP_ID,0) HESAP_ID, isnull(MM_HESAP_ID,-1) MM_HESAP_ID '+

' from KASA '+

' WHERE KASA_ID='+_N(KASA_ID)+

' AND isnull(HESAP_ID,0)>0 ';

Q1.Close;

Q1.SQL.Text:=s;

Q1.Open;

result:=Q1.RecordCount;

end;//KasaHesapBul;

function DemirbasHesapKontrol(DEMIRBAS_ID:integer; Q1:TQuery):integer;

begin

result:=0;

Q1.Close;

Q1.SQL.Text:='select DE.* from DEMIRBAS D, F00000.MUHASEBE_ENTEGRASYON ME,

DEMIRBAS_ENTEGRASYON'+DonemYili+' DE '+

' WHERE ME.MODUL_ID=3 '+

' AND D.DEMIRBAS_ID=DE.DEMIRBAS_ID '+

' AND DE.ENT_ID=ME.ENT_ID '+

' AND D.DEMIRBAS_ID='+_n(DEMIRBAS_ID)+

' AND isnull(DE.HESAP_ID,0)>0 ';

Q1.Open;

if Q1.RecordCount>=2 then //eskiden 9 idi şimdilik kaldırıldı

result:=1;

end;

function StokHesapKontrol(STOK_ID:integer; Q1:TQuery):integer;

begin

result:=0;

Q1.Close;

Q1.SQL.Text:='select SE.* from STOK s, F00000.MUHASEBE_ENTEGRASYON ME,

STOK_ENTEGRASYON'+DonemYili+' SE '+

' WHERE ME.MODUL_ID=5 '+//STOK

' AND S.STOK_ID=SE.STOK_ID '+

' AND SE.ENT_ID=ME.ENT_ID '+

' AND isnull(SE.HESAP_ID,0)>0 '+

' AND S.STOK_ID='+_n(STOK_ID);

Q1.Open;

if Q1.RecordCount>=2 then //şimdilik kaldırıldı 12 idi

result:=1;

end;

function HizmetHesapKontrol(HIZMET_ID:integer; Q1:TQuery):integer;

begin

result:=0;

Q1.Close;

Q1.SQL.Text:='select HE.* from HIZMET H, F00000.MUHASEBE_ENTEGRASYON ME,

HIZMET_ENTEGRASYON'+DonemYili+' HE '+

' WHERE ME.MODUL_ID=7 '+//HIZMET

' AND H.HIZMET_ID=HE.HIZMET_ID '+

' AND HE.ENT_ID=ME.ENT_ID '+

' AND isnull(HE.HESAP_ID,0)>0 '+

' AND H.HIZMET_ID='+_n(HIZMET_ID);

Q1.Open;

if Q1.RecordCount>=2 then //10 idi şimdilik kaldırıldı.

result:=1;

end;

function CSKasaHesapKontrol(CS_KASA_ID:integer; Q1:TQuery):integer;

begin

Q1.Close;

Q1.SQL.Text:='select DE.* from CS_KASA D, F00000.MUHASEBE_ENTEGRASYON ME,

CS_ENTEGRASYON'+DonemYili+' DE '+

' WHERE ME.MODUL_ID=4 '+//FINANS

' AND D.CS_KASA_ID=DE.CS_KASA_ID '+

' AND DE.ENT_ID=ME.ENT_ID '+

' AND isnull(DE.HESAP_ID,0)>0 '+

' AND D.CS_KASA_ID='+_n(CS_KASA_ID);

Q1.Open;

if Q1.RecordCount>=2 then //12 idi şimdilik kaldırıldı.

result:=1;

end;

function PersonelHesapKontrol(PERSONEL_ID:integer; Q1:TQuery):integer;

begin

Q1.close;

Q1.sql.text:=' select M.*,P.HESAP_ID, P.PERSONEL_ID, H.HESAP_KODU, H.HESAP_ADI

' from F00000.MUHASEBE_ENTEGRASYON M, '+

' HESAP_PLANI'+DonemYili+' H, PERSONEL_ENTEGRASYON'+DonemYili+' P

' WHERE M.MODUL_ID=2 '+

' AND M.ENT_ID=P.ENT_ID '+

' AND P.HESAP_ID=H.HESAP_ID '+

' AND isnull(P.HESAP_ID,0)>0 '+

' AND P.PERSONEL_ID='+_n(PERSONEL_ID)+

' ORDER BY UZUN_ADI ';

if Q1.RecordCount>=2 then //şimdilik kaldırıldı 15 idi

result:=1;

end;

function Maskele(Tip:ShortInt; ms, Maske:String):String;

var

S:String;

I:Integer;

k:Integer;

t,tm:integer;

List, ML:TStringList;

TS:String;

begin

t:=0;

List:=TStringList.Create;

ML:=TStringList.Create;

Ts:='';

k:=1;

while k>0 do

begin

t:=t+1;

k:=Pos('.',Maske);

if k<=0 then Ts:=Maske

else

begin

Ts:=Copy(Maske,1,k-1);

Delete(Maske,1,k);

end;

ML.Add(Ts);

end;

if t>0 then

begin

tm:=1;

end;

if ms='' then

begin

Result:=ML[0];

List.Free;

ML.Free;

exit;

end;

Ts:='';

k:=1;

t:=0;

while k>0 do

begin

t:=t+1;

k:=Pos('.',ms);

if k<=0 then Ts:=ms

else

begin

Ts:=Copy(ms,1,k-1);

Delete(ms,1,k);

end;

S:='';

for I:=1 to Length(Ts) do

S:=S+''+Ts[I];

List.Add(S);

end;

if t>0 then

begin

tm:=1;

end;

t:=0;

while ML.Count<List.Count do

begin

t:=t+1;

List.Delete(List.Count-1);

end;

Result:='';

I:=List.Count-1;

if tip=0 then I:=List.Count-2;

for k:=0 to I do

Result:=Result+List[k]+'.';

if I<ML.Count-1 then Result:=Result+ML[I+1]+'.';

Delete(Result,Length(Result),1);

if t>0 then

begin

tm:=1;

end;

List.Free;

ML.Free;

end;

function Mesaj(S:String;MB,tip:UINT):Integer;

begin

case Tip of

MsgBilgi:Result:=MessageBox(GetActiveWindow,PChar(s),'Bilgi',MB or Tip);

MsgUyari:Result:=MessageBox(GetActiveWindow,PChar(s),'Uyarı',MB or tip);

MsgHata:Result:=MessageBox(GetActiveWindow,PChar(s),'Hata',MB or tip);

MsgSoru:Result:=MessageBox(GetActiveWindow,PChar(s),'Soru',MB or tip);

end;//case

end;//Mesaj

function BoslukSil(S:String):String;

var

i:integer;

begin

i:=Length(S);

if S='' then Result:=''

else

begin

while S[i] in [' ','.','_'] do

begin

dec(i);

end;

Result:=Copy(S,1,i);

end;

function Encrypt(S:String):String;

var i,L:Integer;

S2:String;

begin

L:=Length(S);

if L=0 then begin S:='?';L:=1;end;

for i:=1 to 9-L do S:=S+Chr(ord(S[i])+$1);

S:=S+Chr($19+L);

S2:='';

for i:=1 to Length(S)-1 do S2:=S2+Char(ord(S[i])+ord(S[i+1])-$5F);

Result:=S2+S[10];

end;//Encrypt

function Decrypt(S:String):String;

var i:Integer;

S2:String;

begin

S2:=S[10];

for i:=Length(S)-1 downto 1 do S2:=Char(ord(S[i])-ord(S2[1])+$5F)+S2;

Result:=Copy(S2,1,ord(S[10])-$19);

if Result='?' then Result:='';

end;//Decrypt

procedure

ShowMenu(Q1:TQuery;Menu1:TMenuItem;Menu2:TMenuItem;Menu3:TMenuItem;Menu4:TMenuItem;

R_id:integer);

begin

Menu1.Visible:=false;

Menu2.Visible:=false;

Menu3.Visible:=false;

Menu4.Visible:=false;

Q1.Close;

Q1.SQL.Text:=' select * from F00000.BAGLANTILAR '+

' WHERE BAG_KODU='+_n(R_ID);

Q1.Open;

if Q1.FieldByName('RAPOR_ID').AsInteger>3000 then

begin

Menu1.Caption:= Q1.FieldByName('BAG_ADI').Asstring;

Menu1.Visible:=true;

Menu2.Caption:= Q1.FieldByName('BAG_ADI').Asstring;

Menu2.Visible:=true;

Menu3.Caption:= Q1.FieldByName('BAG_ADI').Asstring;

Menu3.Visible:=true;

Menu4.Caption:= Q1.FieldByName('BAG_ADI').Asstring;

Menu4.Visible:=true;

end;

end;//ShowMenu

function AQ(s:STRING):STRING;

var s2:STRING;

i,ts,k:INTEGER;

begin

s2:='';

ts:=0;

k:=Length(s);

for i:=1 to k do

begin

ts:=1;

s2:=s2+s[i];

if s[i]=#39 then s2:=s2+#39;

end;{for ...}

AQ:=s2;

end;{AQ}

procedure showpopup(btn:TBitBtn;p:TPopupMenu);

var

MyPt:Tpoint;

begin

TBitBtn(btn).PopupMenu:=P;

MyPt:=TBitBtn(btn).ClientOrigin;

MyPt.Y:=MyPt.Y+TBitBtn(Btn).Height;

TBitBtn(Btn).PopupMenu.Popup(MyPt.X,MyPt.Y);

end;

procedure showpopupSB(sb:TSpeedButton;p:TPopupMenu);

var

MyPt:Tpoint;

begin

TSpeedButton(sb).PopupMenu:=P;

MyPt:=TSpeedButton(sb).ClientOrigin;

MyPt.Y:=MyPt.Y+TSpeedButton(sb).Height;

TSpeedButton(sb).PopupMenu.Popup(MyPt.X,MyPt.Y);

end;

//Database ile bağlantıyı sağlıyor...

procedure TF_Myunit.medasa_connect;

begin

db2.Connected:=false; //MEDASA OLARAK BAGLANIYOR

db2.Params.Clear;

db2.Params.Add('DATABASE NAME='+DATABASE_NAME);

db2.Params.Add('SERVER NAME='+SERVER_NAME);

db2.Params.Add('USER NAME='+'medasa');

db2.Params.Add('OPEN MODE=READ/WRITE');

db2.Params.Add('SCHEMA CACHE SIZE=8');

db2.Params.Add('BLOB EDIT LOGGING=');

db2.Params.Add('LANGDRIVER=');

db2.Params.Add('SQLQRYMODE=');

db2.Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');

db2.Params.Add('DATE MODE=0');

db2.Params.Add('SCHEMA CACHE TIME=-1');

db2.Params.Add('MAX QUERY TIME=3000');

db2.Params.Add('MAX ROWS=-1');

db2.Params.Add('BATCH COUNT=200');

db2.Params.Add('ENABLE SCHEMA CACHE=FALSE');

db2.Params.Add('SCHEMA CACHE DIR=');

db2.Params.Add('HOST NAME=');

db2.Params.Add('APPLICATION NAME=');

db2.Params.Add('NATIONAL LANG NAME=');

db2.Params.Add('ENABLE BCD=FALSE');

db2.Params.Add('TDS PACKET SIZE=4096');

db2.Params.Add('BLOBS TO CACHE=64');

db2.Params.Add('BLOB SIZE=32');

db2.Params.Add('PASSWORD='+'19');

db2.LoginPrompt:=false;

db2.DatabaseName:='db2';

db2.DriverName:='MSSQL';

db2.Connected:=true;

end; //medasa_connect

Procedure DBConnect;

begin

F_DM.db1.Connected:=false;

F_DM.db1.Params.Clear;

F_DM.db1.Params.Add('DATABASE NAME='+DATABASE_NAME);

F_DM.db1.Params.Add('SERVER NAME='+SERVER_NAME);

F_DM.db1.Params.Add('USER NAME='+DB_USER_NAME);

F_DM.db1.Params.Add('OPEN MODE=READ/WRITE');

F_DM.db1.Params.Add('SCHEMA CACHE SIZE=8');

F_DM.db1.Params.Add('BLOB EDIT LOGGING=');

F_DM.db1.Params.Add('LANGDRIVER=');

F_DM.db1.Params.Add('SQLQRYMODE=');

F_DM.db1.Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');

F_DM.db1.Params.Add('DATE MODE=0');

F_DM.db1.Params.Add('SCHEMA CACHE TIME=-1');

F_DM.db1.Params.Add('MAX QUERY TIME=3000');

F_DM.db1.Params.Add('MAX ROWS=-1');

F_DM.db1.Params.Add('BATCH COUNT=200');

F_DM.db1.Params.Add('ENABLE SCHEMA CACHE=FALSE');

F_DM.db1.Params.Add('SCHEMA CACHE DIR=');

F_DM.db1.Params.Add('HOST NAME=');

F_DM.db1.Params.Add('APPLICATION NAME=');

F_DM.db1.Params.Add('NATIONAL LANG NAME=');

F_DM.db1.Params.Add('ENABLE BCD=FALSE');

F_DM.db1.Params.Add('TDS PACKET SIZE=4096');

F_DM.db1.Params.Add('BLOBS TO CACHE=64');

F_DM.db1.Params.Add('BLOB SIZE=32');

F_DM.db1.Params.Add('PASSWORD='+PSW);

F_DM.db1.LoginPrompt:=false;

F_DM.db1.DatabaseName:='db';

F_DM.db1.DriverName:='MSSQL';

F_DM.db1.Connected:=true;

F_Myunit.medasa_connect;

F_RapLogin.MyDataBase.Connected:=false;

F_RapLogin.MyDataBase.Params.Clear;

F_RapLogin.MyDataBase.Params.Add('DATABASE NAME='+DATABASE_NAME);

F_RapLogin.MyDataBase.Params.Add('SERVER NAME='+SERVER_NAME);

F_RapLogin.MyDataBase.Params.Add('USER NAME='+DB_USER_NAME);

F_RapLogin.MyDataBase.Params.Add('OPEN MODE=READ/WRITE');

F_RapLogin.MyDataBase.Params.Add('SCHEMA CACHE SIZE=8');

F_RapLogin.MyDataBase.Params.Add('BLOB EDIT LOGGING=');

F_RapLogin.MyDataBase.Params.Add('LANGDRIVER=');

F_RapLogin.MyDataBase.Params.Add('SQLQRYMODE=');

F_RapLogin.MyDataBase.Params.Add('SQLPASSTHRU MODE=SHARED AUTOCOMMIT');

F_RapLogin.MyDataBase.Params.Add('DATE MODE=0');

F_RapLogin.MyDataBase.Params.Add('SCHEMA CACHE TIME=-1');

F_RapLogin.MyDataBase.Params.Add('MAX QUERY TIME=3000');

F_RapLogin.MyDataBase.Params.Add('MAX ROWS=-1');

F_RapLogin.MyDataBase.Params.Add('BATCH COUNT=200');

F_RapLogin.MyDataBase.Params.Add('ENABLE SCHEMA CACHE=FALSE');

F_RapLogin.MyDataBase.Params.Add('SCHEMA CACHE DIR=');

F_RapLogin.MyDataBase.Params.Add('HOST NAME=');

F_RapLogin.MyDataBase.Params.Add('APPLICATION NAME=');

F_RapLogin.MyDataBase.Params.Add('NATIONAL LANG NAME=');

F_RapLogin.MyDataBase.Params.Add('ENABLE BCD=FALSE');

F_RapLogin.MyDataBase.Params.Add('TDS PACKET SIZE=4096');

F_RapLogin.MyDataBase.Params.Add('BLOBS TO CACHE=64');

F_RapLogin.MyDataBase.Params.Add('BLOB SIZE=32');

F_RapLogin.MyDataBase.Params.Add('PASSWORD='+PSW);

F_RapLogin.MyDataBase.LoginPrompt:=false;

F_RapLogin.MyDataBase.DatabaseName:='MyDB';

F_RapLogin.MyDataBase.DriverName:='MSSQL';

F_RapLogin.MyDataBase.Connected:=true;

end;//DBConnect

procedure iniKaydet; //ini file yaratılıyor...

begin

inisil;

Meda := TIniFile.Create('meda.ini');

with Meda do

begin

Writestring('MSSQL', 'ServerName',Server_Name);

WriteString('MSSQL', 'DataBase',DataBase_Name);

WriteString('MSSQL', 'User',User_Name);

Free;

end;

procedure inisil; //ini file siliniyor...

begin

inibul;

while inibul=true do

begin

DeleteFile(FileToFind);

inibul;

end;

function inibul:boolean;// true bulundu, false bulunamadı, (ini file

aranıyor...)

var

buffer: array [0..255] of char;

begin

SetCurrentDir('c:');

GetWindowsDirectory(buffer, SizeOf(buffer));

FileToFind := FileSearch('Meda.ini', GetCurrentDir + ';' + buffer);

if FileToFind = '' then

begin

// ShowMessage('Couldn''t find ' + 'Meda.ini' + '.');

result:=false;

end

else

begin

// ShowMessage('Found ' + FileToFind + '.');

result:=true;

end;

procedure inioku; //ini file okunuyor...

begin

Meda := TIniFile.Create('meda.ini');

with Meda do

begin

Server_Name:=Readstring('MSSQL', 'ServerName','' );

DataBase_Name:=ReadString('MSSQL', 'DataBase', '');

User_Name:=ReadString('MSSQL', 'User', '');

Free;

end;

function KodMaskesiBul(Q1:TQuery;ModulID:integer;Seviye:integer):string;

var

s:string;

Kod:string;

i:integer;

k:integer;

begin

s:='select * from F00000.FIRMA_KIRILIMLARI '+

' WHERE MODUL_ID='+_N(MODULID)+

' AND FIRMA_ID='+_N(FirmaID);

Q1.Close;

Q1.SQL.Text:=s;

Q1.Open;

Q1.First;

Kod:='';

k:=1;

while not Q1.Eof do

begin

if k<=seviye then

for i:=1 to Q1.FieldByName('UZUNLUK').AsInteger do

begin

Kod:=Kod+'<>a';

end;

Q1.Next;

k:=k+1;

if (not Q1.Eof) and (k<=seviye) then

Kod:=Kod+'.';

end; //while

result:=Kod;

end; //KodMaseksiBul

procedure AllCheck(CL_List: TCheckListBox); //CheckListBox'daki item'ları seçili

hale getirmek için

var

i:integer;

begin

for i:=0 to CL_List.Items.Count-1 do

begin

CL_List.Checked[i]:=true;

end;

CL_List.SetFocus;

end;

procedure AllNotCheck(CL_List: TCheckListBox); //CheckListBox'daki item'ların

seçimini iptal etmek için

var

i:integer;

begin

for i:=0 to CL_List.Items.Count-1 do

begin

CL_List.Checked[i]:=false;

end;

CL_List.SetFocus;

end;

procedure CheckDownClick(CL_List:

TCheckListBox;SB_Check:TSpeedButton;SB_NotCheck:TSpeedButton);//ComboCheckListBox

Down Click

begin

if CL_List.Visible=false then

begin

CL_List.Visible:=true;

SB_Check.Enabled:=true;

SB_NotCheck.Enabled:=true;

CL_List.SetFocus;

end

else

begin

CL_List.Visible:=false;

SB_Check.Enabled:=false;

SB_NotCheck.Enabled:=false;

end;

procedure CheckExit(CL_List:

TCheckListBox;SB_Check:TSpeedButton;SB_NotCheck:TSpeedButton);//Onexit'a

yazılacak...

begin

CL_List.Visible:=false;

SB_Check.Enabled:=false;

SB_NotCheck.Enabled:=false;

end;

procedure SagdakiSutunaGit(DxGrid:TdxDBGrid);

var

i:Integer;

begin

if DxGrid.State=tsEditing then DxGrid.CloseEditor;

for i:=DxGrid.FocusedColumn+1 to DxGrid.VisibleColumnCount-1 do

begin

if DxGrid.VisibleColumns[i].DisableEditor=False then Break;

end;

if i<DxGrid.VisibleColumnCount then DxGrid.FocusedColumn:=i;

end;

function _yazi(Nmbr:Extended):String;

const

SAYI:array[0..2,0..9] of STRING[10]=

(

('','Bir','İki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz'),

('','On','Yirmi','Otuz','Kırk','Elli','Altmış','Yetmiş','Seksen','Doksan'),

('','Yüz','İkiYüz','ÜçYüz','DörtYüz','BeşYüz','AltıYüz','YediYüz','SekizYüz','DokuzYüz')

);

BASAMAK:array[0..4] of STRING[8]=

('','Bin','Milyon','Milyar','Trilyon');

var uzunluk,i,k,l,m,n,MF:Integer;

S:String[20];

MS,DP:String;

begin

S:=FloatToStr(Nmbr);

i:=Pos(DecimalSeparator,S);

if i>0 then

begin

DP:=Copy(S,i+1,6);

DP:=Copy(IntToStr(Round(StrToInt(DP))),1,2);

S:=Copy(S,1,i-1);

end else DP:='';

uzunluk:=Length(S);

if uzunluk Mod 3=1 then S:='00'+S;

if uzunluk Mod 3=2 then S:='0'+S;

uzunluk:=Length(S);

l:=(uzunluk div 3)-1;

MS:='';

for i:=0 to l do

begin

MF:=0;

for k:=0 to 2 do

begin

n:=(i*3+1)+k;

m:=ord(S[n])-48;

if (k=2) and (MF=0) and (l=1) and (m=1) then begin m:=0;MF:=1;end;

if m>0 then MF:=1;

MS:=MS+SAYI[2-k,m];

end;//for k:=0

if MF=1 then MS:=MS+BASAMAK[l-i];

end;// for i:=

if (Nmbr<1000000) and (int(NMBR)>1) then

begin

int(strtofloat(copy(floattostr(int(nmbr)),length(floattostr(int(nmbr)))-2,3)))=1

then

ms:=ms+'Bir';

nmbr:=

int(strtofloat(copy(floattostr(int(nmbr)),length(floattostr(int(nmbr)))-2,3)));

end;

if DP<>'' then Result:=MS+'%'+DP else Result:=MS;

end;//_yazi

procedure SQLTemizle;

begin

SQLStr1:='';

SQLStr2:='';

SQLStr3:='';

SQLStr4:='';

SQLStr5:='';

BagKodu:=-1;

end;

function Rapor_Goster(RAporid:integer):String;

var

BF:array[0..255] of Char;

BL:Integer;

begin

BL:=255;

GetWindowsDirectory(BF,BL);

_WinPath:=BF;

_WinPath:=_WinPath+'';

F_Onizleme2:=TF_Onizleme2.Create(Application);

if _Devt=1 then F_Onizleme2.WindowState:=wsMaximized;

F_Onizleme2.Goster(RaporId);

end;

Delphi - .....................................