راهنمایی در رابطه با کد کردن بانک اطلاعاتی

[Sabeghi]

با سلام
من یک بانک اکسس دارم که برام اطلاعاتش خیلی خیلی مهمه و همانطور که همه میدونیم به راحتی میشه پسورد بانک اکسس رو در آورد بنابراین ایا دوستان روشی رو بلدند که بشه ساختار بانک اکسس رو تغییر داد که فقط بشه از طریق برنامه ای که مینویسیم قابل باز شدن باشه

با تشکر

[poldasht]

آقا من بانک اطلاعاتی رو کد می کننم ولی یه مشکلی دارم اونم اینه که بالفرض اگه 12000 رکورد باشه نزدیک به 4000 رکورد رو تکراری ثبت می کنه اگه شما ره دیگری رو بلدین ما رو بی نصیب نذارین
البته اگه بخوایین من الگوریتمی که استفاده می کتم رو می ذارم براتون
ایمیل : Saeed.Mohammadiagdam@Gmail.Com

[K.Mohammadreza]

اولا چه چيزي را ميخواي کد کني اطلاعات بانک يا خود بانک؟ بعدشم ميتوني پسوند فايل را به يک پسوند ناشناخته تغيير بدي و قبلشم روي اون رمز بذاري و اطلاعاتتونو هم با يک تابع مثل توابع زير کد کني و در بانک ذخيره و بعد از بازيابي دوباره دي کد کني و نشان بدي.



function Encrypt(Text : string; Key1, Key2, Key3, Key4 : Integer) : string;
var
BufS, Hexa, Hexa1, Hexa2 : string;
BufI, BufI2, Sc, Sl, Num1,
Num2, Num3, Num4, Res1,
Res2, Res3, Res4 : Integer;
begin
Sl := Length(Text);
Sc := 0;
BufS := '';
if (Key1 in [1 .. 120]) and (Key2 in [1 .. 120]) and (Key3 in [1 .. 120]) and (Key4 in [1 .. 120]) then
begin
BufI := Key1 * Key4;
BufI2 := Key3 * Key2;
BufI := BufI - BufI2;
if BufI = 0 then
begin
Result := '';
Exit;
end;
end
else
begin
Result := '';
Exit;
end;
repeat
Inc(Sc);
if Sc > Sl then
Num1 := 0
else
Num1 := Ord(Text[Sc]);
Inc(Sc);
if Sc > Sl then
Num2 := 0
else
Num2 := Ord(Text[Sc]);
Inc(Sc);
if Sc > Sl then
Num3 := 0
else
Num3 := Ord(Text[Sc]);
Inc(sc);
if Sc > Sl then
Num4 := 0
else
Num4 := Ord(Text[Sc]);
Res1 := Num1 * Key1;
BufI := Num2 * Key3;
Res1 := Res1 + BufI;
Res2 := Num1 * Key2;
BufI := Num2 * Key4;
Res2 := Res2 + BufI;
Res3 := Num3 * Key1;
BufI := Num4 * Key3;
Res3 := Res3 + BufI;
Res4 := Num3 * Key2;
BufI := Num4 * Key4;
Res4 := Res4 + BufI;
for BufI := 1 to 4 do
begin
case BufI of
1 : Hexa := IntToHex(Res1, 4);
2 : Hexa := IntToHex(Res2, 4);
3 : Hexa := IntToHex(Res3, 4);
4 : Hexa := IntToHex(Res4, 4);
end;
Hexa1 := '$' + Hexa[1] + Hexa[2];
Hexa2 := '$' + Hexa[3] + Hexa[4];
if (Hexa1 = '$00') and (Hexa2 = '$00') then
begin
Hexa1 := '$FF';
Hexa2 := '$FF';
end;
if Hexa1 = '$00' then
Hexa1 := '$FE';
if Hexa2 = '$00' then
begin
Hexa2 := Hexa1;
Hexa1 := '$FD';
end;
BufS := BufS + Chr(StrToInt(Hexa1)) + Chr(StrToInt(Hexa2));
end;
until Sc >= Sl;
Result := BufS;
end;
//************************************************** ****************************
function Decrypt(Text : string; Key1, Key2, Key3, Key4 : Integer) : string;
var
BufS, Hexa1, Hexa2 : string;
BufI, BufI2, Divzr,
Sc, Sl, Num1, Num2,
Num3, Num4, Res1,
Res2, Res3, Res4 : Integer;
begin
Sl := Length(Text);
Sc := 0;
BufS := '';
if (Key1 in [1 .. 120]) and (Key2 in [1 .. 120]) and (Key3 in [1 .. 120]) and (Key4 in [1 .. 120]) then
begin
Divzr := Key1 * Key4;
BufI2 := Key3 * Key2;
Divzr := Divzr - BufI2;
if Divzr = 0 then
begin
Result := '';
Exit;
end;
end
else
begin
Result := '';
Exit;
end;

repeat
for BufI := 1 to 4 do
begin
Inc(Sc);
Hexa1 := IntToHex(Ord(Text[Sc]), 2);
Inc(Sc);
Hexa2 := IntToHex(Ord(Text[Sc]), 2);
if Hexa1 = 'FF' then
begin
Hexa1 := '00';
Hexa2 := '00';
end;
if Hexa1 = 'FE' then
Hexa1 := '00';
if Hexa1 = 'FD' then
begin
Hexa1 := Hexa2;
Hexa2 := '00';
end;
case BufI of
1 : Res1 := StrToInt('$' + Hexa1 + Hexa2);
2 : Res2 := StrToInt('$' + Hexa1 + Hexa2);
3 : Res3 := StrToInt('$' + Hexa1 + Hexa2);
4 : Res4 := StrToInt('$' + Hexa1 + Hexa2);
end;
end;
BufI := Res1 * Key4;
BufI2 := Res2 * Key3;
Num1 := BufI - BufI2;
Num1 := Num1 div Divzr;
BufI := Res2 * Key1;
BufI2 := Res1 * Key2;
Num2 := BufI - BufI2;
Num2 := Num2 div Divzr;
BufI := Res3 * Key4;
BufI2 := Res4 * Key3;
Num3 := BufI - BufI2;
Num3 := Num3 div Divzr;
BufI := Res4 * Key1;
BufI2 := Res3 * Key2;
Num4 := BufI - BufI2;
Num4 := Num4 div Divzr;
BufS := BufS + Chr(Num1) + Chr(Num2) + Chr(Num3) + Chr(Num4);
until Sc >= Sl;
Result := BufS;
end;


تضمين مي کنم که توابع بالا بهترين توابع براي کد کردن اطلاعاتن

[عقاب سیاه]

درود بر همه
وقتی که بانک اطلاعاتی توسط برنامه باز شود یک فایل هم نام در کنارش ایجاد می شود تازه اگر اکسس هم نصب باشد ایکون اکسس روی اون فایله است خیلی ضایع می شود

نکته بعدی اینکه من تموم تابستان را روی یک بانک اطلاعاتی کار کردم و اگر بخواهم تمامی ورودی ها را با کد بالا رمزی کانم به یک تابستون دیگه نیاز دارم می شه یک راهه ساده تر و سریع تر معرفی کنید؟
راستی MoloBox خوب نیست؟

[K.Mohammadreza]

با سلام به دوست عزيز
شما توابع لازم براي کد کردن اطلاعات را در يونيت جدا گانه قرار بديد و آن در برنامه هايتان اضافه کنيد.
بدليل اينکه از بانک اطلاعاتي اکسس استفاده کرده ايد زمان بازکردن فايل ديتابيس چه بخواهيد چه نخواهيد يک فايل ldb ايجاد مي شود که رکوردها را قفل مي کند که هنگام ويرايش توسط برنامه شما در برنامه ديگر درحال ويرايش نباشند که به اين کار مديريت همزماني اطلاعات مي گويند که البته دلفي بدلي استفاده از sdo نوع قفل رکورد ها را در حالت optimize قرار مي ده ولي در هر صورت اون فايل وجود داره و هيچ کارش نميتوني بکني ولي يک راه پيشنها مي کنم که البته زياد جالب نيست ولي بد نيست روش کار کني
به نظر من بهتر فايل اکسس برنامه را در هنگام بستن برنامه با يک تابع که من اونو در قسمت مباحث عمومي دلفي قرار دادم (ر تاپيک قفل کردن برنامه بطوريکه کسي نتونه بازش کنه) فايل ديتابيس را کد گذاري کني و در هنگام اجراي برنامه مثلا در رويداد FormCreate فرم اصلي و قبل اتصال به ديتا بيس از حالت کد در بياري و استفاده کني که البته يک مشکل باقي ميمونه که اونم اينه که اگر بعد از اجراي برنامه کسي فايل اکسس برنامه را کپي کنه و در جاي ديگري قرار بده ديگر فايلش کد گذاري نيست و ميتونه اطلاعاتشو باز کنه و اونها را دستکاري کنه که اين مشکل هم قابل حله و راه نوشتنش يک کم سخته و زمانبره
و راه حلش اينه که کد هاي vba بنويسي که با باز شدن فايل پايگاه داده کدهاي vba شروع به حذف رکوردها بکنن و تمام جداول و اطلاعات را پاک کنند. به نظر من اين بهترين راه حله که البته باز هم يک مشکل کوچک ميمونه و اونم اينه که !!!!!!!!! اگر کاربر در زمان بازکردن فايل در برنامه اکسس کليد شيفت را نگه داشته باشه کدهاي vba ديگر کار نمي کنن و براي رفع اين مشکل هم بايد يک سري تنظيمات ديگر را انجام بدي که من در اينجا اونها را ميارم
روش غيرفعال كردن دكمه Shift به هنگام باز شدن فايلهاي اكسس را توضيح خواهم داد . در ابتدا بايد مقدمه اي را عنوان كنم.

مقدمه
مطلب زير در زمينه افزايش امنيت سيستم ها است. نكته اي كه در زمينه امنيت هر نوع سيستمي بايد به آن توجه داشت اينست كه بطور كلي امنيت يك امر نسبي است .
بعبارت ديگر يك راه حل امنيتي ، قطعا جلوي بسياري از حملات عليه سيستم را خواهد گرفت ولي هيچگاه بطور كامل حملات را خنثي نخواهد كرد و هميشه حفره هاي امنيتي وجود خواهند داشت .
در يادداشت قبل گفتيم كه به هنگام باز شدن فايلهاي اكسس، Startup اجراء مي شود . به كمك گزينه هاي Startup مي توانيم از دسترسي كاربران به محيط طراحي برنامه جلوگيري كنيم . ولي همانطور كه قبلا گفته شد ميكرو سافت با انگيزه ايجاد سيستم امنيتي چند مرحله اي يك روش ضد امنيتي براي آن ايجاد كرده است و كاربران برنامه ما مي توانند با پايين نگه داشتن دكمه Shift از اجراء Startup جلوگيري كنند و وارد محيط طراحي شوند . حال اگر بخواهيم دكمه شيفت را غير فعال كنيم تا كسي نتواند وارد محيط طراحي شود بايد به اين طريق عمل كرد :

استفاده از خاصيت AllowByPassKey
خاصيت AllowByPassKey يكي از خواص شيء Database است كه:
اگر مقدار آن True باشد دكمه شيفت فعال است .
و اگر مقدار آن False باشد دكمه شيفت غير فعال است .

اين خاصيت عملا در ليست خواص يك Database نيست و بايد آنرا فقط براي اولين بار ايجاد (Create) كرد . بعد از ايجاد آن مي توان مقدار آنرا False يا True كرد .

تذكر : حتما يك كپي از فايل خودتان قبل از اجراء اين برنامه برداريد چون ممكن است ديگر نتوانيد وارد محيط برنامه خودتان شويد . من هم با عرض معذرت وقت پاسخگويي به ايميل هاي دوستان را ندارم و دچار مشكل خواهيد شد.
سه دكمه روي يك فرم ايجاد كنيد و كدهاي زير را در آن بنويسد.
(نمايش كدهاي نوشته شده مناسب نيست ولي اگر آنرا در حافظه كپي كنيد و در ماجول فرمتان كپي كند بدرستي تمايش داده مي شود .)




'براي اولين دفعه :
Private Sub Create_Click()
On Error GoTo Er

Dim db As Database
Dim prp As Property
Set db = CurrentDb
Set prp = db.CreateProperty("allowbypasskey", dbBoolean, False)
db.Properties.Append prp
db.Close

Ex:
Exit Sub
Er:
If Err.Number = 3367 Then
MsgBox "اين خاصيت ايجاد شده و لازم نيست مجددا ايجاد شود"
End If
Resume Ex

End Sub

'جهت غير فعال كردن شيفت
Private Sub ShiftNo_Click()
Dim db As Database
Set db = CurrentDb
db.Properties("allowbypasskey") = False
db.Close
End Sub

'جهت فعال كردن شيفت
Private Sub ShiftOk_Click()
Dim db As Database
Set db = CurrentDb
db.Properties("allowbypasskey") = True
db.Close
End Sub
دوست عزيز اينها تنها بخشي از راههاي رفع مشکل شما هستند که فکر با انجام کارهاي يالا ديگر نيازي به کد کردن اطلاعات نداري هر چند باز هم مي گويم که توابع پست قبلي بهترين توابع براي کد کردن و دي کد کردن اطلاعاتن
کار نوشتن کدهاي پاک کردن اطلاعات هم به عهده خودت
با تشکر

[عقاب سیاه]

خیلی متشکرم:تشویق:
می شود یک نمونه از کد های پاک کردن اطلاعات را هم راهنمایی کنید یا بگزارید. برای این که من تازه کارم و شاید باید خیلی خیلی وقت روی این کد ها بزارم. :عصبانی++:
تو را خدا یه کمکه دیگه بکنید:خجالت:

[K.Mohammadreza]

دوست عزيز خودت هم يک کم وقت بگذار و روي پرو‍ژه ات کار کن
کد هاي زير باعث ميشن که تمام جداول پايگاه داده ات پاک شوند. حال اگر اين پردازه را در زمان بازشدن ديتابيس قرار بدي تمام جداول پاک ميشن



Sub DelteTbls()
Dim sTblNm As String
Dim db As Database, tbldef As DAO.TableDef
Dim i As Integer, Arr As Variant
On Error GoTo DelteTbls_Error

Set db = CurrentDb()

DoCmd.SetWarnings False
For Each tbldef In db.TableDefs
If Left(tbldef.Name, 4) “MSys” And Left(tbldef.Name, 1) “~” Then
Debug.Print tbldef.Name
sTblNm = tbldef.Name

DoCmd.DeleteObject acTable, sTblNm
End If
Next tbldef
MsgBox “Done!”
On Error GoTo 0
SmoothExit_DelteTbls:
Set db = Nothing
DoCmd.SetWarnings True
Exit Sub
DelteTbls_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure DelteTbls”
Resume SmoothExit_DelteTbls
End Sub

[عقاب سیاه]

درود بر همه دوستان
چشم سعی می کنم ولی آخه از یک نوجوان 15 ساله چه انتظاراتی دارید:افسرده:

[a_b_toops]

شما با هر الگوریتمی که می خوای اطلاعات خود خود رو کد کن که این الگوریتم ها در اینترنت بسیار پیدا می شوند ولی برای باز کردن اطلاعات

راهکار به شکل زیر است یک ستون از اطلاعات DBGrid خود را خالی بگذارید
در خاصیت OnDrawColumnCell DBGrid شما می توانید از الگوریتم decode برای آن سلول خالی استفاده کنید

با این راهکار اطلاعات شما هم به صورت کد باقی می ماند و هم می توانید اطلاعات کد شده را DBGrid ببینید

[fahimi]

با تابع Encrypt میشود اطلاعات را کد کرد در جدول ذخیره کرد برای استفاده مجدد استفاده در گزارشات در کجایی جدول بایستی Decrypt کرد

[fahimi]

جهت کد کردن فیلد یک جدول
( table1.findField('name_hazineh').AsString:=Encrypt (edit2.Text,7,6,6,1
جهت دی کد کردن یک جدول روی جدول کلیک میکنیم و در اونت فیلد OnGetText
text := Decrypt(sender.AsString ,7,6,6,1);

[Beygloo]

سلام دوست عزیزم جناب K.Mohammadreza
در پست شماره 3 توابع کد و دیکد کردن رو گذاشتین .
اگر میشه لطف کنید و برای ما مبتدیها با ذکر یک مثال این لطف قشنگتون رو زیباتر کنید.
مثلا برنامه ای که با بانک اکسس کار میکنه.
ممنون

[عقاب سیاه]

سلام اگه ممکنه یه مثال از خد اکسس یعدی کدی که خودش را پاک میکنه قرار بدید نتونستم از نمونه کدتون استفاده کنم:ناراحت:
با تشکر از شما

[K.Mohammadreza]

اين کدها هم همون کار را انجام ميدن يعني پاک کردن جدولها



Public Function dbsTableDelete(DBName)
Count = 0
tblNotFound = False
Do Until tblNotFound
If DBName = dbs2020.TableDefs(Count).Name Then
dbs2020.TableDefs.Delete (DBName)
Exit function
End If
Count = Count + 1
'Determine if we are at the very end of the table listing or not,
'if we are then the table wasn't found,
'end the Do loop and exit the function
If dbs2020.TableDefs.Count = Count Then
tblNotFound = True
End If
Loop
End Function




Public Sub DeleteTables()

Dim db As DAO.Database
Dim tds As DAO.TableDefs
Dim td As DAO.TableDef

Set db = CurrentDb()
Set tds = db.TableDefs

For Each td In tds
If td.Name = Left("Your Pattern", 1) Then
tds.Delete (td.Name)
Else
'<your code>
End If
Next

Set td = Nothing
db.Close
Set db = Nothing

End Sub




Function TableExists(TableName As String) As Boolean
'================================================= ============================
' hlfUtils.TableExists
'-----------------------------------------------------------------------------
' Copyright by Heather L. Floyd - Floyd Innovations - www.floydinnovations.com
' Created 08-01-2005
'-----------------------------------------------------------------------------
' Purpose: Checks to see whether the named table exists in the database
'-----------------------------------------------------------------------------
' Parameters:
' ARGUEMENT : DESCRIPTION
'-----------------------------------------------------------------------------
' TableName (String) : Name of table to check for
'-----------------------------------------------------------------------------
' Returns: True, if table found in current db, False if not found.
'================================================= ============================

Dim strTableNameCheck
On Error GoTo ErrorCode

'try to assign tablename value
strTableNameCheck = CurrentDb.TableDefs(TableName)

'If no error and we get to this line, true
TableExists = True

ExitCode:
On Error Resume Next
Exit Function

ErrorCode:
Select Case Err.number
Case 3265 'Item not found in this collection
TableExists = False
Resume ExitCode
Case Else
MsgBox "Error " & Err.number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
'Debug.Print "Error " & Err.number & ": " & Err.Description & "hlfUtils.TableExists"
Resume ExitCode
End Select

End Function




Private Sub Command2_Click()
Dim cn As New adodb.Connection
Dim rs As New adodb.Recordset
Dim cmd As New adodb.Command
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Booking.mdb;Persist Security Info=False"
cn.Open
Dim a As String
a = Text1.Text
If TableExists(a) Then
MsgBox "yes"
Else
MsgBox "No"
End If
End Sub

‘’’’’’’’’’’’’’’’� �’’’’’’’’’’’’’’’’� ��’’’’’’’’’’’’’’
Function TableExists(TableName As String) As Boolean

Dim strTableNameCheck
On Error GoTo ErrorCode

'try to assign tablename value
strTableNameCheck = CurrentDb.TableDefs(TableName)

'If no error and we get to this line, true
TableExists = True

ExitCode:
On Error Resume Next
Exit Function

ErrorCode:
Select Case Err.number
Case 3265 'Item not found in this collection
TableExists = False
Resume ExitCode
Case Else
MsgBox "Error " & Err.number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
'Debug.Print "Error " & Err.number & ": " & Err.Description & "hlfUtils.TableExists"
Resume ExitCode
End Select

End Function





On Error Resume Next
DoCmd.RunSQL "DROP TABLE tblTestTable"

[عقاب سیاه]

دوست عزیز خیلی ممنون ولی می شه در اکسس 2007 محل دقیق قرار دادن این کد ها را بگین!:تشویق:
تو را خدا ببخشید!:عصبانی++:

[K.Mohammadreza]

دوست عزیز خیلی ممنون ولی می شه در اکسس 2009 محل دقیق قرار دادن این کد ها را بگین!:تشویق:
تو را خدا ببخشید!:عصبانی++:
يا من خيلي از دنيا و نرم افزار عقبم يا شما خيلي جلويد (اکسس 2009) من 2007 را دارم و 2010 هم را در سايت مايکروسافت ديدم ولي اونو ندارم کي 2009 اومده؟
اين کدها را در محيط VBA برنامه اکسس بايد بنويسيد و انو را در startup پايگاه داده قرار بدين که اگر احتما تونست کاربر فايل اکسس شما را در محيط اکسس باز کنه قبل از اينکه بتونه کاري انجام بده تمام جداول پاک مي شن و ضدحال ميخوره

[عقاب سیاه]

ببخشید یک اشتباه بود که درستش کردم:لبخندساده:
با دلفی اشتباه شد:اشتباه: