Luận văn Giới thiệu ngôn ngữ Visual Basic

LUẬN VĂN TỐT NGHIỆP Mục lục NộI dung Phần I GiớI thiệu về ngôn ngữ Visual Basic Lập trình vớI ngôn ngữ Visual Basic Cấu trúc của một chương trình viết bằng ngôn ngữ Visual Basic Phần II Mục đích và yêu cầu của phần mềm Chức năng chính của Phần mềm Phần III Cơ sở dữ liệu Phần IV Mã nguồn Phần I : Giới thiệu ngôn ngữ Visual Basic Ngôn ngữ Visual Basic ngày càng được sử dụng rộng rãi trong các đề án, chương trình thực hiện trong và ngoài nước. Visual Basic được xem là một công cụ phát triển phần mềm thông dụng hiện nay. Sau phiên bản Visual Basic 1.0 là Visual Basic 2.0, đã từng chạy nhanh hơn, dễ sử dụng hơn. Đến Visual Basic 3.0 bổ sung thêm một số phương thức đơn giản, dễ điều khiển cơ sở dữ liệu hơn. Visual Basic 4.0 bổ sung thêm hơn hỗ trợ phát triển 32 bit và bắt đầu tiến trình chuyển Visual Basic thành ngôn ngữ lập trình hướng đốI tượng. Visual Basic 5.0 bổ sung khả năng tạo các điều khiển riêng. Visual Basic 6.0 có thêm nhiều chức năng mạnh như các ứng dụng Internet/ Intranet. . .v.v….. Visual Basic gắn liền vớI khái niệm lập trình trực quan, nghĩa là khi thiết kế chương trình, bạn thấy ngay được kết quả qua từng thao tác. Visual Basic cho phép chỉnh sửa một cách đơn giản, nhanh chóng giao diện của các đốI tượng trong ứng dụng. Đó là một thuận lợI cho ngườI lập trình. VớI Visual Basic, việc lập trình trong Windows đã trở nên hiệu quả hơn và đơn giản hơn rất nhiều. Một khả năng nữa của Visual Basic là khả năng kết hợp các thư viện liên kết động DLLl (Dynamic Link Library). DLL chính là phần mở rộng cho Visual Basic, tức là khi xây dựng một chương trình có một số yêu cầu mà Visual Basic không đáp ứng đầy đủ ta có thể viết các DLL để phụ thêm cho chương trình. Các công cụ để thiết kế giao diện: Như chúng ta đã biết Visual Basic là ngôn ngữ lập trình có tính hướng đốI tượng nên công việc thiết kế giao diện là rất đơn giản. Chúng ta chỉ việc tiến hành đưa các đốI tượng cần thiết trong thanh công cụ vào Form bằng cách kích – kéo sau đó thay đổI các thuộc tính của chúng trên cửa sổ Properties cho phù hợp vớI mục đích lập trình. Form: Form là một biểu mẫu của mỗI ứng dụng trong Visual Basic. Ta dùng Form nhằm mục đích định vị và sắp xếp các bộ phận trên nó khi thiết kế giao diện vớI ngườI sử dụng. Ta có thể xem Form như một bộ phận mà nó có thể chứa các bộ phận khác. Các thành phần trong Form chính của ứng dụng tương tác vớI các Form khác và các bộ phận của chúng tạo nên giao tiếp cho ứng dụng. Form chính là giao diện chính của ứng dụng, các Form khác có thể chứa các công cụ để nhập dữ liệu, xem xét v.v… Trong nhiều ứng dụng của Visual Basic, kích cỡ và vị trí của biểu mẫu lúc thiết kế là kích cỡ mà ngườI dùng sẽ gặp vào lúc sử dụng. Điều này, có nghĩa là Visual Basic cho phép ta thay đổI kích cỡ và di chuyển vị trí Form đến bất cứ nơi nào trên màn hình khi chạy một đề án, bằng cách thay đổI một số thuộc tính của nó trên cửa sổ thuộc tính đốI tượng (Properties Windows ). Thực tế, một trong tính năng thiếu của Visual Basic là khả năng tiến hành các thay đổI động để đáp ứng sự kiện ngườI dùng. Toolbox (hộp công cụ): Toolbox là hộp công cụ chưa các biểu tượng, biểu thị cho các điều khiển mà ta có thể biểu mẫu là bảng chứa các đối tượng đã được định nghĩa sẵn của Visual Basic. Các đối tượng này được sử dụng trong Form để tạo thành giao diện cho các chương trình ứng dụng của Visual Basic. Ta có thể coi hộp công cụ là một hộp “đồ nghề” của người thiết kế chương trình. Scrollbar (thanh cuốn): Scrollbar là đối tượng cho phép nhận từ người dùng một giá trị tuỳ theo vị trí con chạy trên thanh cuốn thay cho các giá trị số. Thanh cuốn có một số thuộc tính quan trọng sau: Thuộc tính Min: xác định cận dưới của thanh cuốn. Thuộc tính Max: xác định cận trên của thanh cuốn. Thuộc tính Value: xác định giá trị tạm thời của thanh cuốn. Option Button (Nút chọn): Đối tượng nút chọn (thường được dùng nhiều nút) cho phép người dùng chọn một trong những lựa chọn đưa ra. Như vậy, tại 1 thời điểm chỉ có thể là 1 trong những nút chọn đuợc chọn Checkbox( hộp kiểm); Cũng như nút chọn, đối tượng hộp kiểm được dùng nhiều hộp một lần. Nhưng khác với nút chọn, hộp kiểm cho phép người dùng lựa một hay nhiều điều kiện. Như vậy tại 1 thời điểm có thể có nhiều hộp kiểm được chọn Label(nhãn): Đối tượng nhãn cho phép người dùng gắn nhãn 1 bộ phận nào đó của giao diện trong lúc thiết kế giao diện cho chương trình ứng dụng . Các nhãn dùng để hiển thị thông tin không muốn người dùng thay đổi. Trong thực tế, các nhãn thường được dùng để định danh 1 hộp văn bản hoặc 1 điều khiển khác bằng việc mô tả nội dung của điều khiển đó. Một công cụ phổ biến cho việc hiển thị thông tin trợ giúp, Picturebox, Image ( hộp ảnh, điều khiển ảnh ); Đối tượng Image và Picturebox dùng để hiển thị ảnh . Nó cho phép người thiết kế đưa hình ảnh từ các file ảnh ( .bmp , .gif …) lên Form Textbox ( hộp văn bản ); Đối tượng Textbox dùng làm hộp nhập dữ liệu cho phép đưa các chuỗi ký tự vào Form. Có thể dùng hộp văn bản để nhập dữ liệu hoặc hiển thị văn bản . Tất cả các công cụ trong windows về chỉnh sửa văn bản như : cut , copy , paste đều dùng trong hộp văn bản Command Button ( nút lệnh ): Khi người dùng kích vào 1 nút lệnh trong biểu mẫu, một thao tác nào đó sẽ được thực hiện tuỳ theo thủ tục sự kiện được viết để đáp ứng sự kiện kích chuột đó . Listbox ( hộp danh sách ): Đối tượng Listbox cho phép kết xuất các thông tin về nhiều chuỗi kí tự vào trong nó thông qua phương thức additem. Thường được dùng để hiển thị thông tin dưới dạng danh sách có liên quan với nhau. Listbox không cho phép người dùng nhập dữ liệu vào. Combo box ( hộp kết hợp ); Công cụ này cho phép người dùng gõ vào thông tin và hiển thị thông tin . nó có tác dụng như hộp danh sách và hộp văn bản . Hộp kết hợp có 3 loại: Hộp kết hợp thả xuống ( drop-down combo ) : là 1 hộp văn bản cho phép người dùng gõ vào, kế bên có 1 mũi tên mà khi nhấn vào nó sẽ xổ ra 1 danh sách cho phép người sử dụng chọn lựa . Hộp kết hợp đơn giản ( simple combo ) : luôn hiển thị danh sách và cho phép người dùng gõ vào hộp văn bản. Hộp danh sách thả xuống ( drop- down list box) : tương tự như hộp kết hợp thả xuống. Danh sách sẽ không hiển thị sẵn nếu người dùng không nhấn vào mũi tên bên cạnh. người sử dụng chỉ có thể chọn từ danh sách, gõ vào hộp văn bản thì danh sách sẽ cuộn đúng đến phần tử yêu cầu và đánh dấu nó. Ole ( đối tượng nhúng ): Ole là viết tắt của Object - Linking and Embedding . Nó cho phép ta nhúng toàn bộ ứng dụng và dữ liệu từ một ứng dụng khác vào chương trình . Ole không chỉ là 1 hệ thống cho phép nhúng hay kết nối dữ liệu từ 1 ứng dụng khác mà vào thời gian chạy của chương trình ta sẽ có 1 bản sao của ứng dụng đó trong chương trình của ta. Nó có khả năng automation cho phép đóng gói các đối tượng chức năng của ứng dụng để có thể sử dụng trong ứng dụng khác. Project explorer : Project explorer trong Visual Basic 6.0 giúp quản lý và định hướng các đề án, biểu mẫu, các module,…. Visual Basic cho phép tổ chức nhiều đề án trong 1 nhóm gọi là project groups. Ta có thể lưu tập hợp các đề án trong Visual Basic thành 1 tập tin nhóm đề án. Các tập tin này có phần mở rộng là .Vbg . Propeties windows ( cửa sổ thuộc tính ): Là nơi chứa danh sách các thuộc tính của một đối tượng cụ thể. Các thuộc tính này có thể khác nhau với từng đối tượng cụ thể. Ta có thể đặt các thuộc tính cho phù hợp với các chương trình ứng dụng. Lập trình trong Visual Basic: Ở phần một, chúng ta mới chỉ biết tuỳ biến biểu mẫu bằng cách bổ xung các điều khiển vào cho phù hợp với yêu cầu của chương trình. Tuy nhiên, đó chỉ có thể coi là bộ mặt của chương trình. Muốn chương trình chạy được thì chúng ta phải thêm vào các thành phần khác như lệnh, dữ liệu. . và cách thức thể hiển chúng trong chương trình. Khi lập trình trong Visual Basic thì phần lớn các mã được xử lý để đáp ứng sự kiện. Ví dụ như sự kiện kích chuột, bấm phím, load form…Các dòng mã thi hành trong một chương trình Visual Basic phải nằm trong các thủ tục hoặc hàm, các dòng lệnh nằm ngoài sẽ không làm việc. Toàn bộ mã lệnh được gõ vào trong cửa sổ code. Cửa sổ code: Cửa số code bao gồm các thành phần sau: Thanh tách: cửa sổ code có một thanh tách (Split bar) nằm đầu thanh cuộn dọc. Mục đích của nó là: khi các dòng mã trở nên nhiều, ta có thể chia cửa sổ code thành 2 phần. Hộp liệt kê Object: nằm ở đầu cửa sổ code bên trái, nó liệt kê tất cả các điều khiển có trên biểu mẫu và thêm vào một đối tượng có tên là: General. Khi thả hộp liệt kê và nhắp vào một đối tượng nào đó thì sẽ đưa ta đến phần mã viết cho đối tượng đó. Hộp Procedure: hộp này cung cấp mọi sự kiện mà đối tượng đã được lựa chọn trong hộp liệt kê object. Intellisence: Intellisence là một công cụ thông minh, nó giúp ta đỡ mất công gõ và tra cứu. Intellisence mở các hộp liệt kê cùng với các thông tin về đối tượng mà ta đang tiếp cận. Nó có 3 phần: QuickInfo: cho ta thông tin về cú pháp của 1 lệnh Visual Basic. Mỗi khi nhập một từ khoá theo sau là một dấu cách hoặc dấu chấm. . .một hộp thoại sẽ hiện ra cung cấp cú pháp của thành phần đó. List properties/Methods: tính năng này đưa ra một danh sách các tính chất và phương pháp của đối tượng ngay khi ta gõ dấu chấm. Available constant : tính năng này cung cấp một danh sách các hằng sẵn có. Biến: Trong Visual Basic, tên biến có thể dài tối đa 255 kí tự. Kí tự đầu tiên phải là một chữ cái và tên biến có thể là một tổ hợp chữ cái, chữ số và dấu gạch dưới. Không được dùng các từ khoá trong Visual Basic ( như end, print. . .) làm tên biến. Visual Basic không phân biệt chữ hoa, chữ thường. Cách khai báo biến: Dim as Phạm vi sử dụng biến phụ thuộc vào cách khai báo biến và vị trí đặt dòng lênh khai báo. Các kiểu dữ liệu: String: các biến string lưu giữ các kí tự. Một chuỗi có thể có một hay nhiều kí tự. Integer: biến nguyên lưu giữ các giá trị số nguyên từ -32768 đến +32767. Long Integer: biến số nguyên dài lưu giữ các số nguyên giữa: -2147483648 đến +214783647. Single precision: các số có phần thập phân gồm: Single precision có độ chính xác đến 7 chữ số và double precision có độ chính xác lên đến 16 vị trí. Currency: Biến tiền tệ là một kiểu mới. Kiểu này cho ta 15 chữ số trước dấu thập phân và 4 chữ số sau dấu thập phân. Date: kiểu dữ liệu ngày tháng. Byte: kiểu byte có thể lưu giữ các số nguyên từ 0 đến 255. Boolean: đây là kiểu logic với các giá trị True/False. Variant: kiểu này được thiết kế để lưu mọi dữ liệu khác nhau của Visual Basic. Các toán tử: Các toán tử tính toán: Các toán tử Ý nghĩa Ví dụ + Có thể dùng để cộng hai toán hạng hoặc hai chuỗi với nhau. X=y+1 A=”A”+”B” - trừ 2 số hạng X=y-1 * Nhân 2 số hạng X=y*2 / Chia, trả về kiểu số thực Y=4/2 \ Chia lấy nguyên X=3\2(x=1) Mod Chia lấy dư X=7 mod 4 (x=3) ^ Lấy luỹ thừa X=y^3 (X=y3) Các toán tử so sánh: Toán tử Ý nghĩa > So sánh xem số thứ nhất có lớn hơn số thứ 2 không < So sánh xem số thứ nhất có nhỏ hơn số thứ 2 không. = So sánh số thứ nhất có bằng số thứ 2 không. So sánh số thứ nhất có khác số thứ 2 không. >= So sánh số thứ nhất có lớn hơn hay bằng số thứ 2 không <= So sánh số thứ nhất có nhỏ hơn hay bằng số thứ 2 không Các toán tử Boolean: Toán tử Ý nghĩa And Chỉ nhận giá trị True nếu cả 2 số hạng đều là True Or Chỉ nhận giá trị False nếu cả 2 số hạng đều là False Not Phủ định giá trị của số hạng Cấu trúc điều khiển: Các cấu trúc chọn: Cấu trúc If….Then… Dạng 1: If then End If Khi gặp một điều lệnh If…..then, Visual Basic sẽ kiểm tra , nếu là True thì máy sẽ thực hiện nếu kêt quả là False thì máy sẽ bỏ qua lệnh và thực hiện những lệnh sau End If. Dạng 2: If then else Khi gặp lệnh này, nếu lấy giá trị True thì thực hiện bỏ qua , còn nếu lấy giá trị False thì bỏ qua và thực hiện . Nhiều khi bạn phải thực hiện nhiều lệnh ứng với điều kiện là True hay False. Để làm được điều đó, ta sử dụng dạng khác của cấu trúc If …..then, có dạng tổng quát như sau: If then else end if Cấu trúc Select Case: Cú pháp: Select case Case ………………… Case …………….. Case else End Select Cấu trúc lặp: Cấu trúc lặp có điều kiện: Cú pháp 1: While Wend Cú pháp 2: Do While được thực hiện lặp đi lặp lại nếu vẫn nhận giá trị True. Do đó, để thoát khỏi vòng lặp thì trong . Trong cú pháp 1, thì được xét trước khi thực hiện các câu lệnh, còn trong cú pháp 2 thì các câu lệnh được thực hiện trước khi xét đến . Cấu trúc For …Next: Cú pháp: For = to [Step ] Next biến Đây là lệnh lặp biết trước số lần lặp. Khi gặp cấu trúc lệnh này, Visual Basic sẽ gán giá trị cho , thực hiện , rồi tăng lên một giá trị tuỳ theo . Vòng lặp này sẽ kết thúc khi có giá trị lớn hơn Cấu trúc For Each….Next: For Each In Next Khi gặp cấu trúc này, Visual Basic sẽ lặp lại cho từng phần tử của mảng, hay các điều khiển…Người ta thường dùng cấu trúc này để duyệt nhiều đối tượng điều khiển. Thủ tục: Trong Visual Basic, một thủ tục mà trước khi ta muốn sử dụng nó thì ta phải định nghĩa nó và ta phải dùng từ khoá “Sub” để khai báo nó. Private/Public Sub End Sub Nếu dùng từ khoá Public, thủ tục có thể được dùng trong bất kì Form nào trong chương trình. Nếu ta khai báo bằng từ khoá Private thì thủ tục chỉ có thể được dùng được trong Form,module chứa nó mà thôi. Giá trị được truyền cho thủ tục thông qua tham số. Một thủ tục có thể có hoặc không có tham số. Khi gọi một thủ tục có tham số, ta phải truyền giá trị cho tham số của thủ tục đó. Trong Visual Basic, có 2 cách để truyền thám số : By Ref ( truyền tham chiếu) và By Val ( truyền tham trị ). Private/Public Sub ( as , , v.v…) End Sub Hiển thị và nhận thông tin: Ta sử dụng các hộp đối thoại để hiển thị thông tin cho người dùng hoặc nhận thông tin. Trong Visual Basic có 4 hộp thoại, đó là: Thông điệp: (MesageBox) Là một hộp thoại đơn giản nhất, gồm 2 loại: Chỉ cung cấp thông tin Tương tác với người sử dụng. Hộp nhập (InputBox): InputBox dùng để nhập thông tin từ người dùng, nó bao gồm một dòng thông báo, hộp soạn thảo và 2 nút “OK” và “Cancel”. Nó có mặt hạn chế là chỉ cho người sử dụng nhập rất ít thông tin. Các hộp thoại thông dụng Bởi hộp thoại này xuất hiện mọi nơi, nên thay vì phải viết chương trình nhiều lần, Windows chứa chúng trong cùng một DLL, Comdlg32.dll hay Comdlg.ocx Có 6 hộp thoại: mở tập tin (File Open) Lưu tập tin (File save). Chọn mầu (Color). Chọn phông (Font). Trợ giúp (Help). In ấn (Print). Hộp thoại hiệu chỉnh (Custom Dialog). Đây là loại hộp đối thoại do người lập trình định nghĩa để tương thích với yêu cầu nhận thông tin của người sử dụng. Nó có ưu điểm là ta có thể thiết kế theo ý thích. Trở ngại của nó là khi thi hành từng biểu mẫu thì sẽ sử dụng tài nguyên hệ thống như bộ nhớ, thời gian CPU. Nếu dùng nhiều hộp thoại hiệu chỉnh trong ứng dụng có thể mất tài nguyên hệ thống và dễ bị treo máy. PhÇn II. Mục đích và chức năng chính của chương trình Quản lý một trung tâm giới thiệu và buôn bán bất động sản là một bài toán lớn . Do đặc thù của công việc này cần phải có sự nhanh nhạy chính xác và đặc biệt cần 1 luồng thông tin đa chiều . Vậy nên ,việc tạo lập 1 phần mềm quản lý các giao dịch nhà đất thông qua mạng thông tin toàn cầu là rất cần thiết . Với phần mềm này , việc thông tin cho các khách hàng có nhu cầu mua bán , thuê mượn nhà đất sẽ được tiện lợi , nhanh chóng hơn. Khi sử dụng chương trình này , khách hàng ( customer ) sẽ phải mua một account đăng ký quyền truy cập để có thể xem thông tin giao dịch ,đồng thời có thể đăng các nhu cầu giao dịch của chính mình thông qua việc email những người quản trị chương trình ( administrator ). Khi nhận được email của khách hàng, administrator sẽ đăng thông tin này lên sau khi đã kiểm chứng tính chính xác của thông tin. * Chức năng chính của chương trình * Bảng phân quyền sử dụng chương trình Menu Function Administrator Customer Transact My House Ok Ok Buying None Ok Selling Ok None Rent None Ok Hire Ok None Find transaction Ok Ok User Update user Ok None Find user Ok None View Browse transaction Ok Ok View user Ok Ok User log summary Ok None View accessed time None Ok Tool Change user password Ok Ok Option Ok None Help Ok Ok Exit Ok Ok * Chi tiết tính năng của chương trình 1. Transaction (giao dịch ) 1.1 My House - Trong chức năng này , người sử dụng chương trình có thê xem thông tin cuả mình đã được đăng tải bằng cách click vào từng thanh công cụ ( rent , buying , selling , hire ) - người sử dụng có thể gửi hoặc nhận thư điện tử trong giao dịch với thanh công cụ my inbox - do nhu cầu thực tế , nên chương trình chỉ cho phép khách hàng ( customer) được đưa thông tin cần mua ( buying ) và thông tin cần thuê ( rent ) và ngược lại administrator chỉ được đăng lên những thông tin giao dịch bán ( selling ) và cho thuê ( hire ) 1.2 Buying -Chức năng này cho phép người sử dụng xem những thông tin chi tiết về việc cần mua nhà đất đang được đăng hiện thời *Buying id : id bán *User id : tên người đăng thông tin *District : quận *Street: phố *location: địa điểm *type house : tình trạng giấy tờ nhà đất *min/max area : diện tích nhà đất người đăng thông tin có thể chấp nhận *direction : hướng nhà đất *width : mặt tiền *number of floor: số tầng *floor no : vị trí tầng *house description : Đăng thông tin chi tiết thêm của người cần chấp nhận -Với các button trên form này như : add , find , modify , cancel, save , close, delete . Người sử dụng có thể chỉnh sửa ,tìm kiếm , đăng thêm thông tin cũng như lưu giữ và hủy bỏ thông tin -Riêng đối với những button như add và modify người sử dụng là khách hàng ( customer) chỉ có thÓ chỉnh sửa và đưa thêm thông tin cho account của chính mình 1.3 Rent Công cụ này cũng tương tự như thanh Buying nhưng là thông tin về giao dịch cho thuê. 1.4/ 1.5 Selling/ hire Hai mục này , chương trình chỉ đăng quyền sử dụng cho administrator . với thông tin cần bán ( selling ) và cần thuê ( hire ) người quản trị cũng có thể chỉnh sửa và đăng thêm thông tin mới - Trên form này cũng có những textbox và button tương tự như rent và buying 1.6 Find transaction -Đây là phần tìm kiếm , nó giúp cho người sự dụng chương trình tiếp cận những thông tin mình cần một cách hiệu quả, nhanh chóng - Trên form chính của mục này cho phép người sử dụng công cụ tìm kiếm theo * transaction type ( kiÓu giao dịch ) : buying, rent, hire, selling *transaction id ( id của giao dịch ) *author id ( tên người sử dụng ) hộp checkbox : match similar id/ author dùng cho phép tìm kiếm tương tự - Với button more : cho phép người sử dụng có thể tìm kiếm theo những tiêu mục cụ thÓ hơn * district : tìm theo quận * direction : tìm theo hướng nhà ( đất ) * location : tìm theo tình trạng vị trí nhà ( mặt tiền , trong ngõ ) * street : tìm theo phố * type : tìm theo kiểu nhà * width : tìm theo kiểu mặt tiền nhà * area : tìm theo diện tích nhà ( đất ) khoảng diện tích có thÓ thực hiện giao dịch * price : tìm theo giá cả ( vnd . usd . tael of gold ) khả năng tài chính có thÓ thực hiện giao dịch * Date of update : tìm theo ngày ( khoảng thời gian ) được đăng thông tin 2. User ( người sử dụng ) Đây là công cụ mà chương trình chỉ cho phép administrator được truy cập và thực hiện những thao tác quản lý người sử dụng chương trình 2.1 update user - Phần này cho phép administrator chỉnh sửa và cập nhật thông tin ( modify )người sử dụng chương trình , đồng thời có thể xóa bỏ thông tin hay tạo lập một account mới ( add new user ) - Thông tin của 1 account gồm có * user id : tên của id * password : tạo mật khÈu * confirm password : xác nhận lại mật khÈu * permission : đăng quyền sử dụng ( administrator , customer ) * clear password : xóa mật khÈu * user name : tên người sử dụng * identify code : mã người sử dụng * sex : giới tính người sử dụng * birth of year : thông tin lứa tuổi người sử dụng * primacy address : địa chỉ người sử dụng * email : địa chỉ thư điện tử * hand phone/ phone number : điện thoại người sử dụng chương trình - khách hàng khi sử dụng chương trình này sẽ phải thanh toán 1 khoản tiền để mua thời gian truy cập và sử dụng thông tin . Thời gian này sẽ được người quản trị chương trình ( administrator ) quản lý và cập nhật . - hộp Time expired : hiÓn thị thời gian người sử dụng chương trình còn trong tài khoản - nút reset : administrator tạo lại thời gian truy cập của khách hàng - nút upgrate : adminstrator cung cấp thời gian truy cập cho khách hàng sau khi nhận được thanh toán 2.2 find user Form này cho phép administrator thực hiện thao tác tìm kiếm thông tin người sử dụng thông qua 2 thanh công cụ user account( account người sử dụng ) và user detail information ( thông tin chi tiết khách hàng ) và nút start search - Tìm kiếm theo user account : * hộp combo box : user id : tìm kiếm theo id người sử dụng check box match similar user id : cho phép tìm kiếm tương đối * Nút more : cho phép tìm kiếm thông tin cụ thÓ hơn * Access time : tìm kiếm theo thời gian truy cập của người sử dụng chương trình * Total account : tìm kiếm theo khoản tiền khách hàng đã thanh toán * Size of inbox : tìm kiếm theo dung lượng của email người sử dụng * Size remain : tìm kiếm theo dung lượng còn lại của email người sử dụng - Tìm kiếm theo user detail information * phần chính của thanh công cụ này tương tự cũng như phần chính của thanh tìm kiếm user account * click nút more : Admin có thể tìm kiếm thông tin người sử dụng một cách chi tiết hơn * user name : tìm kiếm theo tên người sử dụng match similar username tìm kiếm tên tương tự * id card : tìm kiếm theo số id người sử dụng contain word : cho phép tìm kiếm liên quan * year of born : tìm kiếm theo năm sinh người sử dụng * phone/mobile/email : tìm kiếm theo số điện thoại, địa chỉ thư điện tử người sử dụng * contact address : tìm kiếm theo địa chỉ liên lạc người sử dụng 3. View 3.1 browse transaction (duyệt giao dịch) - Trong form này người sử dụng có thể thực hiện thao tác tìm kiếm thông tin 1 cách tổng quát, nhanh chóng thông qua những thanh công cụ selling , buying, for rent , hire - Với những combo box ,item id , author id, district , street người sử dụng duyệt thông tin tổng hợp , kết hợp với thanh công cụ bên trái form - Nút Detail : cho phép người sử dụng chương trình xem chi tiết của thông tin đang hiển thị - Nút advanced search : chức năng của nút này giống chức năng của nút find transaction của phần 1.6 - Nút new advetisment : người sử dụng chức năng này có thê đăng thông tin giao dịch mới ( riêng đối với customer, phần này chỉ có thê đăng thông tin cần bán (buying ) và cho thuê ( rent ) . Nếu muốn đăng thông tin cần mua và cần thuê sẽ phải liên hệ với administrator thông qua email -Nút contact author : cho người sử dụng sử dụng gửi email liên lạc với các user khác 3.2 view user - Xem thông tin chi tiết cá nhân của mình , trong phần naỳ có check box có cho phép người khác xem thông tin cá nhân của mình hay không . - Nút Account : thay đổi mật khẩu 3.3 View accessed time Đây là phần rành riêng cho khách hàng để xem thông tin chi tiết thời gian truy cập của riêng mình 3.4 User log summary Phần này rành riêng cho những administrator , để có thể xem chi tiết thời gian truy cập và sử dụng chương trình của khách hàng 4. Tools 4.1 Change user password Cho người sử dụng chương trình có thể thay đổi password truy cập của riêng mình . 4.2 option Mục này chỉ rành riêng cho administrator , nó giúp cho công tác quản trị chương trình chạy trên INTERNET hoặc mạng LAN * path : thanh công cụ này cho người quản trị mạng chỉ đường dẫn cho chương trình chạy trên mạng nội bộ (local ) hay mạng toàn cầu (network ) * Setup infor : - check request : hiển thị thời gian yêu cầu từ server đến máy trạm - computer : tên máy kết nối với server - rate of exchange : hiển thị tỉ giá vàng và dollar quy đổi ra vnd * Edit item : administrator dùng thanh công cụ này để thay đổi thêm bớt thông tin về địa giới, quận huyện , phố ,tình trạng giấy tờ của nhà (đất) giúp cho khách hàng khi truy cập , sử dụng được dễ dàng . * Backup Đây là phần thông tin về những cơ sở dữ liệu được sao chép dự phòng trên sever - path : chỉ đường dẫn lưu giữ cơ sở dữ liệu - save/ delete/ restore : lưu, xóa , khôi phục dữ liệu Phần III : Cơ sở dữ liệu Bảng 1 Bảng 2 Bảng 3 Bảng 4 Bảng5 Bảng 6 Bảng 7 Bảng 8 Bảng 9 Bảng 10 Bảng 11 Bảng 12 Bảng 13 Bảng 14 Bảng 15 Bảng 16 Bảng 17 Bảng 18 Bảng 19 Phần IV : Mã nguồn 1 số Form chính 1.Form my house Private Sub cmdAdd_Click(Index As Integer) Select Case Index Case 0 frm_adv_new.Show Case 1 End Select End Sub Private Sub cmdCompose_Click(Index As Integer) Select Case Index Case 0 TableT = tblTrans TableM = tblMessage frmCompose.Show (1) Case 1 End Select End Sub Private Sub CmdDelete_Click() Dim Code As String If flagStatus Then MSFGrid.Col = 0 Else MSFGrid.Col = 4 End If Code = MSFGrid.Text If Code = "" Then Exit Sub End If Dim Response As String ' On Error GoTo lblDelBut If flagStatus Then Response = MsgBox("Are you sure delete " & _ "this Transaction ?", vbYesNo, "Warning !") Else Response = MsgBox("Are you sure delete " & _ "this Message ?", vbYesNo, "Warning !") End If Select Case Response Case vbYes MSFGrid.row = SelTransCell If flagStatus Then MSFGrid.Col = 0 Else MSFGrid.Col = 4 End If Code = MSFGrid.Text If Code = "" Then Exit Sub End If rs.MoveFirst Do While Not rs.EOF If flagStatus Then If rs.Fields(0) = Trim(Code) Then rs.Delete LoadTrans (tblTrans) cmdDelete.Enabled = False Exit Sub End If Else If rs.Fields(0) = CLng(Code) Then rs.Delete LoadMessage (tblMessage) cmdDelete.Enabled = False Exit Sub End If End If rs.MoveNext Loop Case vbNo End Select 'lblDelBut: End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub Form_Load() MonthView1.Value = Month(Now) & "/" & Day(Now) & "/" & Year(Now) 'Connection Database Set cn = cnNet Set rs = New ADODB.Recordset Label1.Caption = " " + User_ID InitialValue ChangeInterface 'hide check box cho cac hom thu LblBorderStyleRestart LblRestartColor InstallGrid changeBkColorCell End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) LblRestartColor End Sub ' Dua Backcolor cua cac label ve mau` cua Form Private Sub LblRestartColor() Dim i As Byte For i = 0 To 4 Step 1 lblTrans(i).ForeColor = vbBlack Next i End Sub Private Sub lblTrans_Click(Index As Integer) If Not flagStatus Then ' tranh goi lap ham hideInbox flagStatus = True ChangeInterface End If cmdDelete.Enabled = False MouseClick (Index) Select Case Index Case 0 'Selling tblTrans = "Tbl_Selling" tblMessage = "Tbl_Message_Selling" EcmdAdd (False) Case 1 'Hire tblTrans = "Tbl_Hire" tblMessage = "Tbl_Message_Hire" EcmdAdd (False) Case 2 'Buying tblTrans = "Tbl_Buying" tblMessage = "Tbl_Message_Buying" EcmdAdd (True) Case 3 'Rent tblTrans = "Tbl_Rent" tblMessage = "Tbl_Message_Rent" EcmdAdd (True) Case 4 'Inbox tblMessage = "Tbl_Message_Account" LoadMessage (tblMessage) TSend = False MSFGrid_DblClick GoTo jump End Select LoadTrans (tblTrans) TSend = False jump: BeforeClick = Index 'Xac dinh vi tri lbl da mo truoc do End Sub Private Sub MouseClick(Index As Integer) 'lblTrans(BeforeClick).BorderStyle = 0 'lblTrans(Index).BorderStyle = 1 Dim i As Byte For i = 0 To 4 lblTrans(i).ButtonType = [Flat Highlight] Next i lblTrans(Index).ButtonType = [KDE 2] lblTrans(Index).Refresh End Sub Private Sub MSFGrid_Click() SelTransCell = MSFGrid.MouseRow cmdDelete.Enabled = True End Sub Private Sub InitialValue() flagStatus = True 'o trang thai Transaction Management SelTransCell = -1 ' khong tro vao bat ky Row nao trong Grid chbBeforeClick = 0 BeforeMove = 0 BeforeClick = 0 cmdDelete.Enabled = False 'lblSubject.Caption = "Transaction Management" End Sub Private Sub MSFGrid_DblClick() On Error Resume Next If flagStatus Then SelMailCell = MSFGrid.MouseRow flagStatus = False ChangeInterface MSFGrid.row = SelMailCell MSFGrid.Col = 0 Code = MSFGrid.Text MSFGrid.Col = 1 Tcode = Code 'If lblTrans(4).BorderStyle = 0 Then 'lblNameInbox.Caption = Code + " - " + MSFGrid.Text 'End If LoadMessage (tblMessage) cmdDelete.Enabled = False Else MSFGrid.row = MSFGrid.MouseRow MSFGrid.Col = 0 frmCheck.lblFrom.Caption = MSFGrid.Text MSFGrid.Col = 2 frmCheck.lblDate.Caption = MSFGrid.Text MSFGrid.Col = 1 frmCheck.lblSubject.Caption = MSFGrid.Text MSFGrid.Col = 4 MCode = Trim(MSFGrid.Text) If MCode = "" Then Exit Sub End If frmCheck.Show (1) End If End Sub ================================================== 2.Form Buying Private Sub AddTypeHouse() Dim rsTHouse As ADODB.Recordset Dim SQL As String On Error GoTo Err Set rsTHouse = New ADODB.Recordset SQL = "Select * from Tbl_Type_House;" rsTHouse.Open SQL, cnNet, adOpenKeyset, adLockOptimistic, adCmdText rsTHouse.MoveFirst Do While Not rsTHouse.EOF cobTHouse.AddItem rsTHouse!thouse rsTHouse.MoveNext Loop rsTHouse.Close Err: End Sub Private Sub AddDistrict() Dim rsDistrict As ADODB.Recordset Dim SQL As String On Error GoTo Err Set rsDistrict = New ADODB.Recordset SQL = "Select * from Tbl_District;" rsDistrict.Open SQL, cnNet, adOpenStatic, adLockOptimistic, adCmdText rsDistrict.MoveFirst Do While Not rsDistrict.EOF cobDistrict.AddItem rsDistrict!District rsDistrict.MoveNext Loop rsDistrict.Close Err: End Sub Private Sub AddUserID() Dim rsUserID As ADODB.Recordset Dim SQL As String On Error GoTo Err Set rsUserID = New ADODB.Recordset SQL = "Select * from Tbl_User_Infomation" rsUserID.Open SQL, cnNet, adOpenStatic, adLockOptimistic, adCmdText rsUserID.MoveFirst Do While Not rsUserID.EOF cobUserID.AddItem rsUserID!userid rsUserID.MoveNext Loop rsUserID.Close Err: End Sub Private Sub cmdAdd_Click() Dim ctl As Control For Each ctl In Controls If TypeOf ctl Is CommandButton Then ctl.Enabled = False End If Next ctl cmdSave.Enabled = True cmdCancel.Enabled = True cmdFind.Enabled = True ' cmdHelp.Enabled = True For Each ctl In Controls If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Or TypeOf ctl Is TextBox Then ctl.Text = "" ctl.Enabled = True End If Next ctl txtBuyID.Enabled = False txtBuyID.Text = AutoCode(3, rsBuy) addFlag = True If IsAdmin = True Then cobUserID.Enabled = True Else cobUserID.Enabled = Not True cobUserID.Text = User_ID End If End Sub Private Sub cmdDel_Click() If rsBuy.RecordCount <= 0 Then LockNavi False cmdDel.Enabled = False Exit Sub End If Delete If AnsMsg = vbYes Then Call DelTransact(txtBuyID.Text, cobUserID.Text) End If If rsBuy.RecordCount <= 0 Then Dim ctl As Control For Each ctl In Controls If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then ctl.Text = "" End If Next ctl LockNavi False cmdDel.Enabled = False cmdModify.Enabled = False Exit Sub End If End Sub Private Sub cmdFind_Click() Unload Me frm_find_trans.Show End Sub Private Sub cmdFirst_Click() If rsBuy.RecordCount <= 0 Then Exit Sub End If rsBuy.MoveFirst Display End Sub Private Sub cmdLast_Click() If rsBuy.RecordCount <= 0 Then Exit Sub End If rsBuy.MoveLast Display End Sub Private Sub cmdModify_Click() Dim ctl As Control For Each ctl In Controls If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then ctl.Enabled = True End If If TypeOf ctl Is CommandButton Then ctl.Enabled = False End If Next ctl cobUserID.Enabled = False cmdCancel.Enabled = True cmdSave.Enabled = True addFlag = False End Sub Private Sub cmdNext_Click() If rsBuy.RecordCount <= 0 Then Exit Sub End If rsBuy.MoveNext If rsBuy.EOF Then rsBuy.MoveLast Display End Sub Private Sub cmdPrevious_Click() If rsBuy.RecordCount <= 0 Then Exit Sub End If rsBuy.MovePrevious If rsBuy.BOF Then rsBuy.MoveFirst Display End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub Form_Load() Set rsBuy = New ADODB.Recordset rsBuy.Open "Tbl_Buying", cnNet, adOpenKeyset, adLockPessimistic, adCmdTable 'If UserAdd Then ' UserAdd = False 'End If 'MonthView.Value = If IsAdmin = False Then cmdModify.Enabled = False cmdDel.Enabled = False Else cmdModify.Enabled = Not False cmdDel.Enabled = Not False End If MonthView.Value = Month(Now) & "/" & Day(Now) & "/" & Year(Now) AddDistrict AddTypeHouse AddUserID If rsBuy.RecordCount <= 0 Then LockNavi False cmdDel.Enabled = False cmdModify.Enabled = False End If End Sub Private Sub cmdCancel_Click() 'If UserAdd Then ' cmdExit.Enabled = True ' Unload Me 'End If If IsAdmin = False Then cmdModify.Enabled = False cmdDel.Enabled = False Else cmdModify.Enabled = Not False cmdDel.Enabled = Not False End If LockNavi True cmdAdd.Enabled = True cmdFind.Enabled = True cmdSave.Enabled = False If rsBuy.RecordCount <= 0 Then LockNavi False LockCtl False cmdDel.Enabled = False cmdCancel.Enabled = False cmdModify.Enabled = False Dim ctl As Control EmptyCtl Exit Sub End If rsBuy.CancelUpdate rsBuy.MovePrevious If rsBuy.BOF Then rsBuy.MoveFirst If rsBuy.EOF Then rsBuy.MoveLast Display If IsAdmin = False And LCase(cobUserID.Text) = LCase(User_ID) Then cmdDel.Enabled = True cmdModify.Enabled = True End If End Sub Private Sub cmdSave_Click() Save If Saved = True Then cmdCancel_Click End If addFlag = False If UserAdd Then If Saved = True Then Call MakeTransact(txtBuyID.Text, cobUserID.Text) Unload Me End If End If End Sub ================================================== 3. Form search transaction Private Sub chk_area_Click() If chk_area.Value = 1 Then frm_area.Height = 1475 frm_floor.Top = 5520 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 If chk_expired.Value = 1 Then Me.Height = 8300 Else Me.Height = 7800 End If chk_area.ForeColor = &HFF0000 Else If chk_date.Value = 0 And chk_price.Value = 0 Then If chk_expired.Value = 1 Then Me.Height = 7200 Else Me.Height = 6600 End If frm_floor.Top = 4380 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 End If chk_area.ForeColor = &H808080 frm_area.Height = 375 End If End Sub Private Sub chk_date_Click() If chk_date.Value = 1 Then frm_date.Height = 1475 If chk_expired.Value = 1 Then Me.Height = 8300 Else Me.Height = 7800 End If frm_floor.Top = 5520 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 chk_date.ForeColor = &HFF0000 Else If chk_area.Value = 0 And chk_price.Value = 0 Then If chk_expired.Value = 1 Then Me.Height = 7200 Else Me.Height = 6600 End If frm_floor.Top = 4380 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 End If chk_date.ForeColor = &H808080 frm_date.Height = 385 End If End Sub Private Sub chk_direct_Click() If chk_direct.Value = 1 Then cmb_direct.Visible = True chk_direct.ForeColor = &HFF0000 Else cmb_direct.Visible = False chk_direct.ForeColor = &H808080 End If End Sub Private Sub chk_dist_Click() If chk_dist.Value = 1 Then cmb_dist.Visible = True chk_dist.ForeColor = &HFF0000 Else cmb_dist.Visible = False chk_dist.ForeColor = &H808080 End If End Sub Private Sub chk_expired_Click() If chk_expired.Value = 1 Then chk_expired.ForeColor = &HFF0000 frm_expired.Height = 900 Me.Height = Me.Height + 500 Else chk_expired.ForeColor = &H808080 frm_expired.Height = 345 Me.Height = Me.Height - 500 End If End Sub Private Sub chk_floor_num_Click() If chk_floor_num.Value = 1 Then cmb_operator1.Visible = True lbl1.Visible = True txt_value1.Visible = True frm_floor.Width = 7245 chk_floor_num.ForeColor = &HFF0000 Else chk_floor_num.ForeColor = &H808080 If chk_tot_floor.Value = 0 Then frm_floor.Width = 1980 End If cmb_operator1.Visible = False lbl1.Visible = False txt_value1.Visible = False End If End Sub Private Sub chk_h_type_Click() If chk_h_type.Value = 1 Then chk_floor_num.Value = 0 chk_tot_floor.Value = 0 If cmb_h_type.Text = cmb_h_type.List(6) Or cmb_h_type.Text = cmb_h_type.List(7) Or cmb_h_type.Text = cmb_h_type.List(8) Then chk_floor_num.Enabled = False chk_tot_floor.Enabled = False Else chk_floor_num.Enabled = True chk_tot_floor.Enabled = True End If cmb_h_type.Visible = True chk_h_type.ForeColor = &HFF0000 Else chk_floor_num.Value = 0 chk_tot_floor.Value = 0 chk_floor_num.Enabled = False chk_tot_floor.Enabled = False cmb_h_type.Visible = False chk_h_type.ForeColor = &H808080 End If End Sub Private Sub chk_loc_Click() If chk_loc.Value = 1 Then cmb_loc.Visible = True chk_loc.ForeColor = &HFF0000 Else chk_loc.ForeColor = &H808080 cmb_loc.Visible = False End If End Sub Private Sub chk_price_Click() If chk_price.Value = 1 Then cmb_cur.Visible = True frm_price.Height = 1475 If chk_expired.Value = 1 Then Me.Height = 8300 Else Me.Height = 7800 End If frm_floor.Top = 5520 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 chk_price.ForeColor = &HFF0000 Else If chk_date.Value = 0 And chk_area.Value = 0 Then If chk_expired.Value = 1 Then Me.Height = 7200 Else Me.Height = 6600 End If frm_floor.Top = 4380 frm_expired.Top = frm_floor.Top + frm_floor.Height + 100 End If frm_price.Height = 375 chk_price.ForeColor = &H808080 cmb_cur.Visible = False End If End Sub Private Sub chk_street_Click() If chk_street.Value = 1 Then cmb_street.Visible = True chk_street.ForeColor = &HFF0000 Else cmb_street.Visible = False chk_street.ForeColor = &H808080 End If End Sub Private Sub chk_tot_floor_Click() If chk_tot_floor.Value = 1 Then cmb_operator2.Visible = True lbl2.Visible = True txt_value2.Visible = True frm_floor.Width = 7245 chk_tot_floor.ForeColor = &HFF0000 Else If chk_floor_num.Value = 0 Then frm_floor.Width = 1980 End If cmb_operator2.Visible = False lbl2.Visible = False txt_value2.Visible = False chk_tot_floor.ForeColor = &H808080 End If End Sub Private Sub chk_width_Click() If chk_width.Value = 1 Then lbl_width.Visible = True txt_width.Visible = True chk_width.ForeColor = &HFF0000 Else lbl_width.Visible = False txt_width.Visible = False chk_width.ForeColor = &H808080 End If End Sub Private Sub chk7_Click() End Sub Private Sub chk9_Click() End Sub Private Sub chk1_Click() If chk1.Value = 1 Then chk1.ForeColor = &HFF0000 Else chk1.ForeColor = &H808080 End If End Sub Private Sub chk2_Click() If chk2.Value = 1 Then chk2.ForeColor = &HFF0000 Else chk2.ForeColor = &H808080 End If End Sub Private Sub cmb_dist_Click() Call Add_Street(cmb_dist.Text) End Sub Private Sub cmb_h_type_Click() If cmb_h_type.Text = cmb_h_type.List(6) Or cmb_h_type.Text = cmb_h_type.List(7) Or cmb_h_type.Text = cmb_h_type.List(8) Then chk_floor_num.Enabled = False chk_tot_floor.Enabled = False Else If chk_h_type.Value = 1 Then chk_floor_num.Enabled = True chk_tot_floor.Enabled = True End If End If End Sub Private Sub Command1_Click() End Sub Private Sub cmd_search_Click() If Check_Condition = False Then Exit Sub End If Call Set_Condition lbl_pro.Visible = True pic1.Visible = True DoEvents frm_tran_res.lst1.ColumnHeaders.Clear frm_tran_res.lst1.ListItems.Clear frm_tran_res.lst1.ColumnHeaders.Add , , "Item ID" frm_tran_res.lst1.ColumnHeaders.Add , , "Type" frm_tran_res2.lst1.ColumnHeaders.Clear frm_tran_res2.lst1.ListItems.Clear frm_tran_res2.lst1.ColumnHeaders.Add , , "Item ID" frm_tran_res2.lst1.ColumnHeaders.Add , , "Type" Call Search_Trans(True, TblTran, AuthID, AuthID_chk, TranID, TranID_chk, Street, District, HType, Location, Direct, HWidth, FDate, LDate, Oper1, Oper2, Value1, Value2, FExpired, LExpired, MinArea, MaxArea, MinPrice, MaxPrice) End Sub Private Sub Command3_Click() Unload Me End Sub Private Sub cmdClose_Click() Unload frm_find_trans End Sub Private Sub Form_Load() If User_Permission = "Administrator" Then chk_expired.Enabled = True End If Set cnnFind = New ADODB.Connection 'cnn.Open "Provider=" & "Microsoft.Jet.OLEDB.3.51;" & "Data Source=" & App.Path & "\Database\advertisement.mdb;" & "Jet OLEDB:Database Password=" & "dankadv;" cnnFind.Provider = "Microsoft.Jet.OLEDB.4.0" cnnFind.Open App.Path & "\database\nhadatdatabase.mdb" frm_floor.Width = 1980 frm_floor.Top = 4380 frm_area.Height = 375 frm_area.Height = 375 frm_price.Height = 375 frm_date.Height = 375 Me.Height = 2590 ' Me.WindowState = 0 Call Default End Sub '-------------------------------------------------------------------------------- If District " " And District "( ALL )" Then 'Match District If rs!District = District Then FDistrict = True Else FDistrict = False End If Else FDistrict = True End If '-------------------------------------------------------------------------------- If Street " " And Street "( ALL )" Then 'Match Street If rs!Street = Street Then FStreet = True Else FStreet = False End If Else FStreet = True End If '-------------------------------------------------------------------------------- If Direction " " Then 'Match Direction If rs!Direction = Direction Then FDirection = True Else FDirection = False End If Else FDirection = True End If '-------------------------------------------------------------------------------- If Location " " Then 'Match Location If rs!Location = Location Then FLocation = True Else FLocation = False End If Else FLocation = True End If '-------------------------------------------------------------------------------- If HWidth -1 Then 'Match Width If rs!Width >= HWidth Then FWidth = True Else FWidth = False End If Else FWidth = True End If '-------------------------------------------------------------------------------- If FDate " " Then 'Match Date of Update Dim Max If CDate(FDate) > CDate(LDate) Then Max = FDate LDate = FDate FDate = Max End If If CDate(rs!dofupdate) >= FDate And CDate(rs!dofupdate) <= LDate Then FoDate = True Else FoDate = False End If Else FoDate = True End If '-------------------------------------------------------------------------------- If FExpired " " Then 'Match Date of Expired Dim MaxD If CDate(FExpired) > CDate(LExpired) Then MaxD = FExpired LExpired = FExpired FExpired = Max End If If CDate(rs!dofupdate) >= FExpired And CDate(rs!dofupdate) <= LExpired Then FoExpired = True Else FoExpired = False End If Else FoExpired = True End If '-------------------------------------------------------------------------------- If HType " " Then ' Match House Type If LCase(rs!thouse) = LCase(HType) Then FType = True Else FType = False End If Else FType = True End If '-------------------------------------------------------------------------------- 'Match Area If MinArea -1 And MaxArea = -1 Then ' Min only If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!area >= MinArea Then FArea = True Else FArea = False End If Else If rs!MinArea >= MinArea Then FArea = True Else FArea = False End If End If End If If MinArea = -1 And MaxArea -1 Then 'Max Only If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!area <= MaxArea Then FArea = True Else FArea = False End If Else If rs!MaxArea >= MaxArea Then FArea = True Else FArea = False End If End If End If If MinArea -1 And MaxArea -1 Then 'Min And Max If TblTran = "tbl_selling" Or TblTran = "tbl_hire" Then If rs!area >= MinArea And rs!area <= MaxArea Then FArea = True Else FArea = False End If Else If rs!minTarea >= MinArea And rs!MaxTarea <= MaxArea Then FArea = True Else FArea = False End If End If End If If MinArea = -1 And MaxArea = -1 Then FArea = True End If '-------------------------------------------------------------------------------- 'Match Price If MinPrice -1 And MaxPrice = -1 Then If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!Price >= MinPrice Then FPrice = True Else FPrice = False End If Else If rs!MinPrice >= MinPrice Then FPrice = True Else FPrice = False End If End If End If If MinPrice = -1 And MaxPrice -1 Then If TblTran = "tbl_selling" Or TblTran = "tbl_rent" Then If rs!Price <= MaxPrice Then FPrice = True Else FPrice = False End If Else If rs!MaxPrice >= MaxPrice Then FPrice = True Else FPrice = False End If End If End If If MinPrice -1 And MaxPrice -1 Then If TblTran = "tbl_selling" Or TblTran = "tbl_hire" Then If rs!Price >= MinPrice And rs!Price <= MaxPrice Then FPrice = True Else FPrice = False End If Else If rs!MinPrice >= MinPrice And rs!MaxPrice <= MaxPrice Then FPrice = True Else FPrice = False End If End If End If If MinPrice = -1 And MaxPrice = -1 Then FPrice = True End If '-------------------------------------------------------------------------------- 'Match Floor number If Oper1 6 Then If Oper1 = 0 Then If rs!fno Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 1 Then If rs!fno = Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 2 Then If rs!fno > Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 3 Then If rs!fno >= Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 4 Then If rs!fno < Value1 Then FFloorNum = True Else FFloorNum = False End If End If If Oper1 = 5 Then If rs!fno <= Value1 Then FFloorNum = True Else FFloorNum = False End If End If Else FFloorNum = True End If '-------------------------------------------------------------------------------- 'Match Total of floor If Oper2 6 Then If Oper2 = 0 Then If rs!toffloor Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 1 Then If rs!toffloor = Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 2 Then If rs!toffloor > Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 3 Then If rs!toffloor >= Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 4 Then If rs!toffloor < Value2 Then FFloorTot = True Else FFloorTot = False End If End If If Oper2 = 5 Then If rs!toffloor <= Value2 Then FFloorTot = True Else FFloorTot = False End If End If Else FFloorTot = True End If '-------------------------------------------------------------------------------- 'FINAL UNION FOUND CONDITION If FTran = True And FAuth = True And FDistrict = True _ And FStreet = True And FWidth = True And FoDate = True _ And FDirection = True And FLocation = True And FType = True _ And FArea = True And FPrice = True And FoExpired = True _ And FFloorNum = True And FFloorTot = True Then found = found + 1 End Function ================================================== 4. Form compose Private Sub Initial() rtxtBox.Text = "" cboSize.Text = "10" cboFont.Text = "MS Sans Serif" End Sub Private Sub lblTransparent() Dim i As Byte For i = 0 To 8 picAlign(i).BackColor = vbButtonFace Next i End Sub Private Sub cboFont_LostFocus() rtxtBox.SelFontName = cboFont.Text rtxtBox.Refresh End Sub Private Sub cboSize_Change() On Error GoTo lbl rtxtBox.SelFontSize = cboSize.Text rtxtBox.Refresh lbl: End Sub Private Sub cboSize_LostFocus() rtxtBox.SelFontSize = cboSize.Text rtxtBox.Refresh End Sub Private Sub cmdClose_Click(Index As Integer) Unload Me End Sub Private Sub cmdSend_Click(Index As Integer) If txtTo.Text = "" Then MsgBox "You must enter the UserName to sent to !", vbInformation, "Message can not be send " Exit Sub End If txtTo.Text = Trim(txtTo.Text) If rtxtBox.Text = "" Then MsgBox "You must type in the message to be sent !", vbInformation, "Message empty !" rtxtBox.SetFocus Exit Sub End If Dim rsU As ADODB.Recordset Set rsU = New ADODB.Recordset rsU.Open "tbl_Account", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If rsU.RecordCount <= 0 Then Exit Sub End If rsU.MoveFirst Dim Ex As Boolean Ex = False Do While Not rsU.EOF If LCase(rsU.Fields(0)) = LCase(txtTo.Text) Then Ex = True Exit Do End If rsU.MoveNext Loop If Ex = False Then MsgBox "The User '" & txtTo.Text & "' is not exist . Please check down your Send to !", vbCritical, "User Invalid" Exit Sub End If Select Case Index Case 0 Call UpdateM Case 1 End Select MsgBox "Message has been sent to " & txtTo.Text & " !", vbOKOnly + vbInformation, "Note !" Unload Me End Sub Private Sub Form_Load() lblTransparent Initial End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not FFlag Then lblTransparent FFlag = True End If End Sub Private Sub picAlign_Click(Index As Integer) If Index >= 0 And Index <= 5 Then picAlign(Index).BorderStyle = _ (picAlign(Index).BorderStyle + 1) Mod 2 End If Select Case Index Case 0 rtxtBox.SelBold = Not rtxtBox.SelBold Case 1 rtxtBox.SelItalic = Not rtxtBox.SelItalic Case 2 rtxtBox.SelUnderline = Not rtxtBox.SelUnderline Case 3 rtxtBox.SelAlignment = vbLeftJustify Case 4 rtxtBox.SelAlignment = vbCenter Case 5 rtxtBox.SelAlignment = vbRightJustify Case 6 Seltext = rtxtBox.Seltext rtxtBox.Seltext = "" Case 7 Seltext = rtxtBox.Seltext Case 8 rtxtBox.Seltext = Seltext End Select If Index = 3 Then picAlign(ClickPicAlign).BorderStyle = 0 ClickPicAlign = Index End If If Index >= 6 And Index <= 8 Then picAlign(ClickPicEdit).BorderStyle = 0 ClickPicEdit = Index End If End Sub Private Sub picAlign_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Index >= 6 And Index <= 8 Then picAlign(Index).BorderStyle = 1 End If End Sub Private Sub picAlign_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Index MoveLabel Then picAlign(MoveLabel).BackColor = vbButtonFace picAlign(Index).BackColor = vbWhite '&H80000016 MoveLabel = Index End If FFlag = False End Sub Private Sub picAlign_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Index >= 6 And Index <= 8 Then picAlign(Index).BorderStyle = 0 End If End Sub Private Sub UpdateM() Dim rs As New ADODB.Recordset If Not TSend Then TableM = "Tbl_Message_Account" End If rs.Open TableM, cnNet, adOpenDynamic, adLockPessimistic, adCmdTable rs.AddNew rs!RUserID = Trim(txtTo.Text) rs!Suserid = User_ID rs!DofSending = Date rs!Subject = txtSubject.Text If TSend Then rs.Fields(1) = Tcode End If rtxtBox.SaveFile (netPathDir + "User\" + Trim(txtTo.Text) + "\" + CStr(rs.Fields(0)) + ".rtf") rs.Update End Sub ================================================== 5.form browse transaction Private Sub cmb_auth_Click() cmd_qsearch.Enabled = True End Sub Private Sub cmb_dist_Click() cmd_qsearch.Enabled = True If cmb_dist.Text = "( ALL )" Then Dim rs_street As ADODB.Recordset Set rs_street = New ADODB.Recordset rs_street.Open "Tbl_street", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable rs_street.MoveFirst Do While Not rs_street.EOF cmb_street.AddItem rs_street.Fields(2).Value rs_street.MoveNext Loop Exit Sub End If Call Add_Street End Sub Private Sub cmb_id_Click() cmd_qsearch.Enabled = True End Sub Private Sub cmb_id_GotFocus() cmb_id.SelStart = 0 cmb_id.SelLength = Len(cmb_id.Text) End Sub Private Sub cmb_street_Click() cmd_qsearch.Enabled = True End Sub Private Sub cmd_close_Click() Unload Me End Sub Private Sub cmd_cont_Click() Dim au As String Dim item_name As String grid1.row = row_auth grid1.Col = 6 au = grid1.Text grid1.Col = 1 item_name = grid1.Text If row_auth = 0 Then MsgBox "You must choose one of User in the list", vbInformation, "Contact Failed !" Exit Sub End If If Tab_i = 1 Then ' Tab_i = TableM = "tbl_message_selling" End If If Tab_i = 2 Then ' Tab_i = TableM = "tbl_message_buying" End If If Tab_i = 3 Then ' Tab_i = TableM = "tbl_message_rent" End If If Tab_i = 4 Then ' Tab_i = TableM = "tbl_message_hire" End If Tcode = item_name frmCompose.txtTo = au Unload Me frmCompose.Show End Sub Private Sub cmd_detail_Click() Dim i As Byte For i = 1 To 4 If tab1.Tabs(i).Selected Then Tab_i = i End If Next i Me.Hide frm_adv_det.List_Call = True frm_adv_det.Item_call = grid1.TextMatrix(grid1.RowSel, 1) frm_adv_det.Show End Sub Private Sub cmd_find_Click() Unload Me frm_find_trans.Show End Sub Private Sub cmd_list_all_Click() If tab1.Tabs(1).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Selling", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then ' MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_SH Call ADD_ITEM_SEL End If If tab1.Tabs(2).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Buying", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then ' MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_BR Call ADD_ITEM_SEL End If If tab1.Tabs(3).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Rent", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then 'MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_BR Call ADD_ITEM_SEL End If If tab1.Tabs(4).Selected Then Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Hire", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable If grid1.rows - 1 = Rs_local.RecordCount Then 'MsgBox "You've already list all item", vbExclamation, "Listing Failed !" Exit Sub End If grid1.Clear Create_grid_header_SH Call ADD_ITEM_SEL End If End Sub Private Sub cmd_New_Click() frm_adv_new.Show vbModal End Sub Private Sub cmd_qsearch_Click() row = 0 grid1.Enabled = True Dim found As Boolean Dim completed As Boolean Dim f_id As Boolean Dim f_street As Boolean Dim f_dist As Boolean Dim f_auth As Boolean Dim i As Integer Dim per As Integer If cmb_id.Text = "( ALL )" And cmb_street.Text = "( ALL )" And cmb_dist.Text = "( ALL )" And cmb_auth.Text = "( ALL )" Then If grid1.rows Rs_local.RecordCount Then Call ADD_ITEM_SEL End If Exit Sub End If grid1.Clear If cmb_id.Text = "" And cmb_street.Text = "" And cmb_dist.Text = "" And cmb_auth.Text = "" Then MsgBox "You must type in on value in one of Item ID, Street, District or Author ID", vbExclamation, "Quick Search Failed !" cmd_qsearch.Enabled = False Exit Sub Else If Rs_local.RecordCount >= 1 Then Rs_local.MoveFirst pic_progress.Visible = True pic_progress.Refresh Do While Not Rs_local.EOF per = per + 1 UpdateStatus pic_progress, per / Rs_local.RecordCount, "Searching ...", True found = False If Rs_local.Fields(0) = cmb_id.Text Then 'Item ID match or not f_id = True Else f_id = False If cmb_id.Text = "( ALL )" Then f_id = True End If End If If tab1.Tabs(1).Selected Or tab1.Tabs(4).Selected Then If Rs_local!Street = cmb_street.Text Then 'Match street for Sell and Hire f_street = True Else f_street = False If cmb_street.Text = "( ALL )" Then f_street = True End If End If If Rs_local!District.Value = cmb_dist.Text Then 'match distict f_dist = True Else f_dist = False If cmb_dist.Text = "( ALL )" Then f_dist = True End If End If If Rs_local!userid = cmb_auth.Text Then 'Match author f_auth = True Else f_auth = False If cmb_auth.Text = "( ALL )" Then f_auth = True End If End If Else If Rs_local!Street = cmb_street.Text Then 'Match street for buy and Rent f_street = True Else f_street = False If cmb_street.Text = "( ALL )" Then f_street = True End If End If If Rs_local!District.Value = cmb_dist.Text Then 'match distict f_dist = True Else f_dist = False If cmb_dist.Text = "( ALL )" Then f_dist = True End If End If If Rs_local!userid = cmb_auth.Text Then 'Match author f_auth = True Else f_auth = False If cmb_auth.Text = "( ALL )" Then f_auth = True End If End If End If If f_id = True And f_street = True And f_auth = True And f_dist = True Then found = True End If If found = True Then completed = True row = row + 1 grid1.rows = row + 1 If tab1.Tabs(1).Selected Or tab1.Tabs(4).Selected Then Call ADD_ITEM Call Create_grid_header_SH Else Call ADD_ITEM_B Call Create_grid_header_BR End If End If Rs_local.MoveNext Loop pic_progress.Visible = False 'If completed = False Then ' MsgBox "Item not found !", vbExclamation, "Searching Comleted!" ' Call Create_grid_header ' grid1.rows = 1 ' grid1.Enabled = False 'End If End If End If End Sub Private Sub Command1_Click() grid1.Col = grid1.MouseCol grid1.row = grid1.MouseRow MsgBox grid1.Text End Sub Private Sub Form_Load() user_name = User_ID Call Rs_selling Call statusbar Call create_tabs Call Create_grid_header_SH Call Header_alig_cen Call Column_width_SH grid1.ScrollTrack = True Timer1.Enabled = True cmb_street.AddItem "( ALL )" cmb_dist.AddItem "( ALL )" cmb_dist.AddItem "Ba §×nh" cmb_dist.AddItem "CÇu GiÊy" cmb_dist.AddItem "§èng §a" cmb_dist.AddItem "Hai Bµ Tr­ng" cmb_dist.AddItem "Hoµn KiÕm" cmb_dist.AddItem "T©y Hå" cmb_dist.AddItem "Thanh Xu©n" cmb_dist.Text = cmb_dist.List(0) cmb_dist_Click cmb_street.Text = cmb_street.List(0) End Sub Private Sub statusbar() 'Adding Items to Status bar Dim cpl As Panel Set cpl = stat_bar.Panels.Add(1, , " Advertisment Page ") cpl.AutoSize = sbrContents Set cpl = stat_bar.Panels.Add(2, , " Current User : " & user_name & " ") cpl.Bevel = sbrNoBevel cpl.Width = 2900 cpl.AutoSize = sbrNoAutoSize Set cpl = stat_bar.Panels.Add(3, , " Please Wait ! ") 'cpl.AutoSize = sbrSpring cpl.Width = 4020 Set cpl = stat_bar.Panels.Add(4, , , sbrDate) cpl.AutoSize = sbrContents cpl.Alignment = sbrCenter Set cpl = stat_bar.Panels.Add(5, , , sbrTime) cpl.AutoSize = sbrContents cpl.Alignment = sbrCenter End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) stat_bar.Panels(2).Bevel = sbrNoBevel End Sub Private Sub frm_option_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.MousePointer = 0 stat_bar.Panels(2).Bevel = sbrNoBevel End Sub Private Sub grid1_DblClick() Dim i As Byte For i = 1 To 4 If tab1.Tabs(i).Selected = True Then Tab_i = i End If Next i frm_adv_det.List_Call = True frm_adv_det.Item_call = grid1.TextMatrix(grid1.RowSel, 1) Unload Me frm_adv_det.Show End Sub Private Sub grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) row_auth = grid1.MouseRow If Multi_sel = True Then ' Disable Multi Select grid1.HighLight = flexHighlightWithFocus Multi_sel = False End If Row_sel = grid1.RowSel If row_auth 0 Then If Button = 2 Then PopupMenu mnuact End If End If End Sub Private Sub grid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Y > 4780 Then grid1.ToolTipText = "" frm_adv.MousePointer = 0 Exit Sub End If Dim name_u As String If grid1.rows <= 1 Then Exit Sub End If If grid1.MouseCol = 6 And grid1.MouseRow > 0 Then If grid1.TextMatrix(grid1.MouseRow, 6) "" Then frm_adv.MousePointer = 99 frm_adv.MouseIcon = LoadPicture(App.Path & "\image\link.ico") name_u = grid1.TextMatrix(grid1.MouseRow, 6) grid1.ToolTipText = " Contact to " & name_u & " " Else grid1.ToolTipText = "" frm_adv.MousePointer = 0 Exit Sub End If Else grid1.ToolTipText = "" frm_adv.MousePointer = 0 End If If grid1.MouseRow = 0 Then grid1.ToolTipText = "" frm_adv.MousePointer = 0 End If End Sub Private Sub grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Row_new_sel = grid1.RowSel If Row_sel Row_new_sel Then Multi_sel = True grid1.HighLight = flexHighlightNever End If End Sub Private Sub Image4_Click() Unload Me End Sub Private Sub create_tabs() tab1.TabFixedHeight = 600 tab1.TabFixedWidth = (tab1.Height - 90) / 4 tab1.Tabs(1).Caption = "Selling" tab1.Tabs(1).ToolTipText = "Selling Items" tab1.Tabs.Add 2, , "Buying" tab1.Tabs.Add 3, , "For Rent" tab1.Tabs.Add 4, , "Hire" End Sub Private Sub mnucont_Click() cmd_cont_Click End Sub Private Sub mnudet_Click() Dim i As Byte For i = 1 To 4 If tab1.Tabs(i).Selected Then Tab_i = i End If Next i Me.Hide frm_adv_det.Show End Sub Private Sub mnuDetail_Click() cmd_detail_Click End Sub Private Sub mnuFInd_Click() cmd_find_Click End Sub Private Sub mnunew_Click() cmd_New_Click End Sub Private Sub stat_bar_Click() If user_acc = True Then Unload Me frm_account.Acc_user_id = User_ID frm_account.Show End If End Sub Private Sub stat_bar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If X stat_bar.Panels(2).Left Then stat_bar.Panels(2).Bevel = sbrRaised user_acc = True stat_bar.Panels(2).ToolTipText = "Check for " & user_name & "'s account " stat_bar.MousePointer = ccCustom stat_bar.MouseIcon = LoadPicture(App.Path & "\image\link.ico") Else user_acc = False stat_bar.MousePointer = ccArrow stat_bar.Panels(2).Bevel = sbrNoBevel End If End Sub Private Sub tab1_Click() If tab1.Tabs(1).Selected Then If Tab_index = 1 Then Exit Sub Else Tab_index = 1 End If Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Selling", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable grid1.Clear Create_grid_header_SH Call ADD_ITEM_SEL End If If tab1.Tabs(2).Selected Then If Tab_index = 2 Then Exit Sub Else Tab_index = 2 End If Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Buying", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable grid1.Clear Create_grid_header_BR Call ADD_ITEM_SEL End If If tab1.Tabs(3).Selected Then If Tab_index = 3 Then Exit Sub Else Tab_index = 3 End If Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Rent", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable grid1.Clear Create_grid_header_BR Call ADD_ITEM_SEL End If If tab1.Tabs(4).Selected Then If Tab_index = 4 Then Exit Sub Else Tab_index = 4 End If Rs_local.Close Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_Hire", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable grid1.Clear Create_grid_header_SH Call ADD_ITEM_SEL End If End Sub Private Sub Timer1_Timer() Call ADD_ITEM_SEL Timer1.Enabled = False End Sub Private Sub Rs_selling() ' Create rs_local connection Set Rs_local = New ADODB.Recordset Rs_local.Open "Tbl_selling", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable 'Rs_local.Open "auth", cnnet, adOpenKeyset, adLockOptimistic, adCmdTable End Sub ====================================================== 6. form user manager Private Sub cmdNext_Click() With rsAccount .MoveNext If .EOF Then .MoveLast End With With rsUserInfo .MoveNext If .EOF Then .MoveLast End With 'cobPermission.Text = rsAccount!Permission 'cobAge.Text = rsUserInfoBofYear Display End Sub Private Sub cmdPrevious_Click() With rsAccount .MovePrevious If .BOF Then .MoveFirst End With With rsUserInfo .MovePrevious If .BOF Then .MoveFirst End With 'cobPermission.Text = rsAccount!Permission 'cobAge.Text = rsUserInfoBofYear Display End Sub Private Sub cmdReset_Click() Dim ans As Integer ans = MsgBox("Are you sure to Reset this Account's accession time?", vbYesNo, "Warning!") If ans = vbNo Then Exit Sub Else txtStockLeft.Text = "0000" txtExprised.Text = "00.00" End If End Sub Private Sub cmdAdd_Click() Dim ctl As Control For Each ctl In Controls If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Then ctl.Enabled = True ctl.Text = "" End If If TypeOf ctl Is CommandButton Then ctl.Enabled = False End If Next ctl cmdSave.Enabled = True cmdCancel.Enabled = True cmdFind.Enabled = True cmdHelp.Enabled = True cmdClearPass.Enabled = True txtExprised.Text = "12.00" rsUserInfo.AddNew rsAccount.AddNew cobUserID.SetFocus cobPermission.Text = "Customer" optMale.Value = True txtExprised.Text = "12.00" txtStockLeft.Text = "0" cmdAdd.Enabled = False cmdSave.Enabled = True cmdHelp.Enabled = True cmdFind.Enabled = True cmdExit.Enabled = False cmdFirst.Enabled = False cmdPrevious.Enabled = False cmdNext.Enabled = False cmdLast.Enabled = False cmdReset.Enabled = False cmdUpgrade.Enabled = True cmdDel.Enabled = False cmdCancel.Enabled = True addFlag = True End Sub Private Sub cmdSave_Click() On Error GoTo Err '==============CHECK INPUT DATA================== If Len(cobUserID) 16 Then MsgBox "User ID must be more than 4 characters and less then 16 characters. Please Enter a valid Name in the UserID field!", vbOKOnly, "System Alert!" cobUserID.SetFocus Exit Sub End If If Len(txtPass) > 50 Or Len(txtConPass) > 50 Then MsgBox "Password must less than 50 characters.", vbOKOnly, "System Alert!" txtPass.SetFocus Exit Sub End If If txtPass.Text txtConPass.Text Then MsgBox "The Password you typed don't match. Please type and confirm the Password again.", vbOKOnly, "System Alert" txtPass.SetFocus Exit Sub End If If txtIDCode = "" Then MsgBox "Please Enter your Identify Code.", vbOKOnly, "System Alert" txtIDCode.SetFocus Exit Sub End If '=====================================END CHECK=============== Save frmUserMan.Refresh Err: If Err.Number = -2147217887 Then rsUserInfo.CancelUpdate rsAccount.CancelUpdate cobUserID.SetFocus End If Display End Sub Private Sub cmdUpgrade_Click() Dim X As Integer Dim s As String s = (InputBox("Enter New access time:", "House Transaction Center")) If IsNumeric(s) = True Then X = CInt(s) Else MsgBox "Please enter new valid time stock for this user", vbOKOnly, "Warning!" cmdUpgrade.SetFocus End If txtExprised.Text = X End Sub Private Sub cobAge_GotFocus() Dim i As Integer For i = 1930 To 2100 cobAge.AddItem i Next i End Sub Private Sub cobUserID_GotFocus() AddUserID End Sub Private Sub Form_Activate() If user_i "" Then Do While Not rsUserInfo.EOF If user_i = rsUserInfo!userid Then Exit Do End If rsUserInfo.MoveNext Loop Do While Not rsAccount.EOF If user_i = rsAccount!userid Then Exit Do End If rsAccount.MoveNext Loop End If Display End Sub Private Sub Form_Load() 'creat the connection to table Tbl_User_Infomation Set rsUserInfo = New ADODB.Recordset rsUserInfo.Open "Tbl_User_Infomation", cnNet, adOpenDynamic, adLockOptimistic, adCmdTable 'creat the connection to table Tbl_Account Set rsAccount = New ADODB.Recordset rsAccount.Open "Tbl_Account", cnNet, adOpenDynamic, adLockOptimistic, adCmdTable cobPermission.Text = "" cmdSave.Enabled = False End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Call ImplodeForm(Me, 2, 500, 1) 'Effects End Sub Public Sub MakeDir() Dim fso As New FileSystemObject Dim dir As Folder On Error GoTo Err fso.CreateFolder (netPathDir + "User\" + cobUserID.Text) Exit Sub Err: MsgBox "This Folder is already exist", vbOKOnly End Sub Private Sub txtAddress_GotFocus() txtAddress.SelStart = 0 txtAddress.SelLength = Len(txtAddress) End Sub Public Sub RemoveDir() Dim fso As New FileSystemObject Dim dir As Folder On Error GoTo Err Set dir = fso.GetFolder(netPathDir + "User\" + cobUserID) dir.Delete Exit Sub 'RmDir netPathDir + "User\" + cobUserID Err: MsgBox "Folder is not exist ! Nothing is deleted", vbOKOnly, "Warning" End Sub Public Sub Save() With rsUserInfo ' .AddNew !userid = cobUserID.Text If txtUserName.Text "" Then !UserName = txtUserName.Text End If If txtIDCode.Text "" Then !idcard = txtIDCode.Text End If If txtAddress.Text "" Then !caddress = txtAddress.Text End If If cobAge.Text "" Then !bofyear = cobAge.Text End If If txtPhone.Text "" Then !phone = txtPhone.Text End If If txtHandphone.Text "" Then !mobile = txtHandphone.Text End If If txtEmail.Text "" Then !email = txtEmail.Text End If !sex = optMale.Value .Update End With With rsAccount ' .AddNew !userid = cobUserID.Text !Password = txtConPass.Text !permission = cobPermission.Text !accesstime = txtExprised.Text !taccount = txtStockLeft.Text rsAccount.Update End With cmdAdd.Enabled = True cmdSave.Enabled = False cmdHelp.Enabled = True cmdFind.Enabled = True cmdExit.Enabled = True cmdFirst.Enabled = True cmdPrevious.Enabled = True cmdNext.Enabled = True cmdLast.Enabled = True cmdReset.Enabled = True cmdUpgrade.Enabled = True cmdDel.Enabled = True If addFlag Then Call MakeDir End If MsgBox "Record Update successful.", vbOKOnly, "Note" End Sub ====================================================== 7. Form user information Private Sub chk_view_info_Click() cmdSave.Enabled = True End Sub Private Sub cmd_acc_Click() frm_account.Acc_user_id = Me.Us_ID Unload Me frm_account.Show End Sub Private Sub cmd_Exit_Click() Unload Me 'mdi.Show End Sub Private Sub Create_rs_lan() Set Rs_LAN = New ADODB.Recordset Rs_LAN.Open "Tbl_User_Infomation", cnNet, adOpenKeyset, adLockOptimistic, adCmdTable End Sub Private Sub cmdSave_Click() View_info = chk_view_info.Value 'MsgBox Rs_LAN!userid If View_info = True Then Rs_LAN.Fields(9).Value = True Else Rs_LAN.Fields(9).Value = False End If Rs_LAN.Update cmdSave.Enabled = False End Sub Private Sub Form_Load() Call Create_rs_lan ' Us_ID = User_ID Me.Caption = "Information about " & Us_ID End Sub Public Sub Match_user_ID(UserName As String) F = False Do While Not Rs_LAN.EOF If UserName = Rs_LAN!userid Then Call Display If UserName = User_ID Then cmdSave.Enabled = True chk_view_info.Enabled = True cmd_acc.Enabled = True Else cmdSave.Enabled = Not True chk_view_info.Enabled = Not True cmd_acc.Enabled = Not True End If Exit Do End If Rs_LAN.MoveNext Loop If F = False Then MsgBox "User " & Us_ID & " in not exist at the moment !", vbCritical, " User not exist !" frm_adv_det.Adv_det_call = True Unload Me End If End Sub Private Sub Display() F = True txt_address.Locked = True lbl_userID.Caption = Rs_LAN!userid 'User Id can't be Null lbl_user_name.Caption = Rs_LAN!UserName 'User name can't be Null If IsNull(Rs_LAN!bofyear) = False Then 'Year of birth can be NULL lbl_year.Caption = Rs_LAN!bofyear Else lbl_year.Caption = "" End If If Rs_LAN!sex = True Then lbl_sex.Caption = "Male" ' Sex can't be Null Else lbl_sex.Caption = "Female" End If If IsNull(Rs_LAN!caddress) = False Then 'Address can be NULL txt_address.Text = Rs_LAN!caddress Else lbl_year.Caption = "" End If lbl_ID.Caption = Rs_LAN!idcard ' ID Card can't be Null If IsNull(Rs_LAN!phone) = False Then ' Phone Number can be NULL lbl_phone.Caption = Rs_LAN!phone Else lbl_year.Caption = "" End If If IsNull(Rs_LAN!mobile) = False Then 'Mobile phone can be NULL lbl_mobile.Caption = Rs_LAN!mobile Else lbl_year.Caption = "" End If If IsNull(Rs_LAN!email) = False Then 'E-mail can be NULL lbl_email.Caption = Rs_LAN!email Else lbl_year.Caption = "" End If If Rs_LAN!viewinfo = True Then chk_view_info.Value = 1 View_info = True Else chk_view_info.Value = 0 View_info = False Dim ctl As Control For Each ctl In Controls If TypeOf ctl Is label Then ctl.Enabled = False End If Next ctl 'frm_user.Enabled = False 'frm_per.Enabled = False End If 'txt_address.Locked = True End Sub Private Sub Not_view() Me.Visible = False MsgBox "You are not allowed to view " & Us_ID & " personal information !", vbCritical, "Not Authorized !" Unload frm_user_detail End Sub ====================================================== 8. Form option Option Explicit Dim tblEdit As String Dim rsEdit As ADODB.Recordset Dim flagCancelEdit As Boolean, flagStreet As Boolean Dim flagCancel As Boolean, flagAdd As Boolean Dim flagRate As Boolean Dim rowSel1 As Long, rowSel2 As Long 'cho fgridbackup Dim RowSelRestore As Long Private Sub chkPath_Click() If chkPath.Value = 0 Then chkPathE (False) Else chkPathE (True) End If End Sub Private Sub cmdApply_Click() Dim fso As New FileSystemObject Dim fil As File, ts As TextStream Dim TypePath As Byte If tbsOptions.SelectedItem.Index = 1 Then If fso.FileExists(PathLogFile) = False Then fso.CreateTextFile (PathLogFile) Else Set fil = fso.GetFile(PathLogFile) End If Set ts = fil.OpenAsTextStream(ForWriting) ts.WriteLine (txtNetpath.Text) ts.WriteLine (txtLocalPath.Text) ts.WriteLine (txtCRequest.Text) ts.WriteLine (txtComputer.Text) ts.Close cmdApply.Enabled = False Call InitialData End If netPathDir = Left(NetPath, Len(NetPath) - Len("Database\NhadatDatabase.mdb")) If flagRate And tbsOptions.SelectedItem.Index = 2 Then Call UpdateRate cmdApply.Enabled = False End If End Sub Private Sub cmdBackupBrow_Click() On Error GoTo dlgerror With dlgFileOpen .CancelError = True .ShowOpen .Filter = "*.*" txtBPath.Text = .FileName End With dlgerror: End Sub Private Sub cmdBackupSave_Click() Call backup Call DispDatagrid Call chkPathE(False) chkPath.Value = 0 fgridBackup.SetFocus 'fgridBackup.RowSel End Sub Private Sub cmdCancel_Click() flagCancel = True Unload Me End Sub Private Sub cmdDelBackup_Click() Dim temp As Long Dim rsBackup As ADODB.Recordset Dim Response As String If rowSel1 > rowSel2 Then temp = rowSel1 rowSel1 = rowSel2 rowSel2 = temp End If If rowSel1 rowSel2 Then Response = MsgBox("Are you sure Delete" & _ " " & rowSel2 - rowSel1 + 1 & " Backups ?", _ vbYesNo, "Warning !") Else Response = MsgBox("Are you sure Delete" & _ " this Backup ?", vbYesNo, "Warning !") End If 'Huy Delete khi click vao No If Response = vbNo Then Exit Sub End If '==============Delete Recordsets============= Set rsBackup = New ADODB.Recordset rsBackup.Open "Tbl_Backup", cnNet, adOpenDynamic, _ adLockPessimistic, adCmdTable With rsBackup For temp = rowSel1 To rowSel2 .MoveFirst Do While Not .EOF If .Fields(0) = fgridBackup.TextMatrix(temp, 0) Then Call DelFile(.Fields(0), .Fields(3)) .Delete Exit Do End If .MoveNext Loop Next temp End With MsgBox "Files have been deleted.", vbOKOnly, "Note !" Call DispDatagrid End Sub Private Sub cmdOk_Click() Unload Me End Sub Private Sub cboEdit_GotFocus(Index As Integer) Dim i As Byte If Index 0 Then For i = 0 To cboEdit(0).ListCount - 1 If cboEdit(0).Text = cboEdit(0).List(i) Then Exit Sub End If Next i MsgBox "You must select Item from Type Edit.", vbOKOnly, "Warning !!!" cboEdit(0).SetFocus End If Select Case Index Case 0 Case 1 Case 2 Case 3 End Select End Sub Private Sub cboEdit_LostFocus(Index As Integer) 'Dim Item As String Select Case Index Case 0 If cboEdit(0).Text "" Then Call cmdEditE(True, False, False, False) End If '==========Case 1========== Select Case cboEdit(0).ListIndex Case 0 tblEdit = "Tbl_District" cboEdit(1).Width = 2115 txtEditContent.Width = 2115 cboEdit(2).Visible = False Call AddItemcboEdit(1, 1) flagStreet = False Case 1 tblEdit = "Tbl_District" Call AddItemcboEdit(1, 2) tblEdit = "Tbl_Street" flagStreet = True cboEdit(1).Width = 2115 txtEditContent.Width = 2115 cboEdit(2).Visible = True cboEdit(2).SetFocus Case 2 tblEdit = "Tbl_Type_House" cboEdit(1).Width = 3000 txtEditContent.Width = 3000 cboEdit(2).Visible = False flagStreet = False Call AddItemcboEdit(1, 1) Case Else Exit Sub End Select '==========End Case 1========== Case 1 If cboEdit(0).ListIndex = 1 And cboEdit(1).Text = "" Then MsgBox "You must select District before Street selection !", vbOKOnly, "Warning !" cboEdit(2).SetFocus End If 'If cboEdit(0).ListIndex 1 And cboEdit(1).Text "" Then Call cmdEditE(True, True, False, True) txtEditContent.Text = cboEdit(1).Text 'ElseIf cboEdit(0).ListIndex = 1 Then ' txtEditContent.Text = cboEdit(1).Text 'End If Case 2 If cboEdit(2).Text "" Then If flagAdd Then Call cmdEditE(True, False, True, False) Else Call cmdEditE(False, True, True, False) End If Call AddcboStreet End If End Select End Sub Private Sub cmdEdit_Click(Index As Integer) Select Case Index Case 0 If Not flagCancelEdit Then cmdEdit(Index).Caption = "Cancel" Call cmdEditE(True, False, True, False) cboEdit(1).Enabled = False flagCancelEdit = True flagAdd = True txtEditContent.SetFocus txtEditContent.Locked = False txtEditContent.Text = "" Else cmdEdit(Index).Caption = "Add New" Call cmdEditE(True, True, False, True) cboEdit(1).Enabled = True flagCancelEdit = False cboEdit(0).SetFocus txtEditContent.Locked = True txtEditContent.Text = "" End If Case 1 If Not flagCancelEdit Then cmdEdit(Index).Caption = "Cancel" flagCancelEdit = True flagAdd = False txtEditContent.Locked = False Call cmdEditE(False, True, True, False) Else cmdEdit(Index).Caption = "Modify" txtEditContent.Text = "" flagCancelEdit = False txtEditContent.Locked = True Call cmdEditE(True, True, False, True) End If Case 2 txtEditContent.Locked = True flagCancelEdit = False cboEdit(1).Enabled = True cmdEdit(0).Caption = "Add New" cmdEdit(1).Caption = "Modify" If flagAdd Then Call UpdateEdit(0, tblEdit) Else Call UpdateEdit(1, tblEdit) End If txtEditContent.Text = "" cboEdit(0).SetFocus Call cmdEditE(True, True, False, True) Case 3 DeleteEdit txtEditContent.Text = "" cboEdit(0).SetFocus Call cmdEditE(False, False, False, False) End Select End Sub Private Sub cmdResBackup_Click() Dim fso As New FileSystemObject Dim Dfile As File Dim TypeData As String Dim Index As String With fgridBackup .row = RowSelRestore .Col = 0 Index = CStr(.Text) .Col = 3 TypeData = .Text End With Select Case TypeData Case "nhadatDatabase" Set Dfile = fso.GetFile(netPathDir + "Backup\N" + Index + ".mdb") Call Dfile.Copy(netPathDir + "Database\nhadatDatabase.mdb", True) Case "ServerDatabase" Set Dfile = fso.GetFile(netPathDir + "Backup\S" + Index + ".mdb") Case "ALL" Set Dfile = fso.GetFile(netPathDir + "Backup\N" + Index + ".mdb") Call Dfile.Copy(netPathDir + "Database\nhadatDatabase.mdb", True) Set Dfile = fso.GetFile(netPathDir + "Backup\S" + Index + ".mdb") Call Dfile.Copy(netPathDir + "Database\ServerDatabase.mdb", True) End Select MsgBox "Databases have been Restored.", vbOKOnly, "Note !" End Sub Private Sub fgridBackup_Click() RowSelRestore = fgridBackup.MouseRow End Sub Private Sub fgridBackup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) rowSel1 = fgridBackup.MouseRow End Sub Private Sub fgridBackup_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) rowSel2 = fgridBackup.MouseRow End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Dim i As Integer 'handle ctrl+tab to move to the next tab If Shift = vbCtrlMask And KeyCode = vbKeyTab Then i = tbsOptions.SelectedItem.Index If i = tbsOptions.Tabs.Count Then 'last tab so we need to wrap to tab 1 Set tbsOptions.SelectedItem = tbsOptions.Tabs(1) Else 'increment the tab Set tbsOptions.SelectedItem = tbsOptions.Tabs(i + 1) End If End If End Sub Private Sub Form_Load() 'center the form Me.Move (Screen.Width - Me.Width) / 2, _ (Screen.Height - Me.Height) / 4 'tbsOptions.Tabs (1) Call cmdEditE(False, False, False, False) Call DispPath Call DispRate Call DispDatagrid Call SizeGrid txtEditContent.Locked = True '==============Frame 3===============' txtBPath.Enabled = False cmdBackupBrow.Enabled = False lblBackupPath.Enabled = False fgridBackup.Enabled = True netPathDir = Left(NetPath, Len(NetPath) - Len("Database\NhadatDatabase.mdb")) End Sub Private Sub tbsOptions_Click() Dim i As Integer 'show and enable the selected tab's controls 'and hide and disable all others For i = 0 To tbsOptions.Tabs.Count - 1 If i = tbsOptions.SelectedItem.Index - 1 Then fraOptions(i).Left = 210 fraOptions(i).Enabled = True Else fraOptions(i).Left = -20000 fraOptions(i).Enabled = False End If Next If tbsOptions.SelectedItem.Index = 1 Or tbsOptions.SelectedItem.Index = 2 Then cmdApply.Enabled = True Else cmdApply.Enabled = False End If End Sub Private Sub cmdSetupBrow_Click() Dim TypePath As Byte Select Case cboTypePath.Text Case "Network" TypePath = 0 Case "Local" TypePath = 1 Case Else MsgBox "You must select TypePath", vbOKOnly, "Stop !!" cboTypePath.SetFocus Exit Sub End Select On Error GoTo dlgerror With dlgFileOpen .CancelError = True .ShowOpen .Filter = "*.*" If TypePath = 0 Then .DialogTitle = "Select Network Path" txtNetpath.Text = .FileName Else .DialogTitle = "Select Local Path" txtLocalPath.Text = .FileName End If End With dlgerror: End Sub Private Sub DispPath() txtNetpath.Text = NetPath txtLocalPath.Text = LocalPath txtCRequest.Text = CheckTime txtComputer.Text = ComName End Sub Private Sub cmdSetupTest_Click() Dim cnNetTest As ADODB.Connection, cnLocalTest As ADODB.Connection On Error GoTo cnerror Set cnNetTest = New ADODB.Connection cnNetTest.Provider = "Microsoft.Jet.oledb.3.51" cnNetTest.Open txtNetpath.Text 'Connection Local Machine Set cnLocalTest = New ADODB.Connection cnLocalTest.Provider = "Microsoft.Jet.oledb.3.51" cnLocalTest.Open txtLocalPath.Text MsgBox "Connection successful !!!", vbOKOnly, "Test Connection " Exit Sub cnerror: MsgBox "Connection has a problem." + Chr(13) + _ "Contact Administrator for Help.", vbOKOnly, "Warning !!!" End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Dim fso As New FileSystemObject Dim fil As File, ts As TextStream Dim TypePath As Byte If Not flagCancel Then If fso.FileExists(PathLogFile) = False Then fso.CreateTextFile (PathLogFile) Else Set fil = fso.GetFile(PathLogFile) End If Set ts = fil.OpenAsTextStream(ForWriting) ts.WriteLine (txtNetpath.Text) ts.WriteLine (txtLocalPath.Text) ts.WriteLine (txtCRequest.Text) ts.WriteLine (txtComputer.Text) ts.Close Call InitialData If flagRate Then Call UpdateRate End If End If End Sub Private Sub cmdEditE(Optional ByVal f0 As Boolean _ , Optional ByVal f1 As Boolean, Optional ByVal f2 As _ Boolean, Optional ByVal f3 As Boolean) cmdEdit(0).Enabled = f0 cmdEdit(1).Enabled = f1 cmdEdit(2).Enabled = f2 cmdEdit(3).Enabled = f3 End Sub Private Sub AddItemcboEdit(ByVal IndexS As Integer, ByVal IndexD As Integer) 'On Error GoTo lbl Set rsEdit = New ADODB.Recordset rsEdit.Open tblEdit, cnNet, adOpenDynamic, adLockPessimistic, adCmdTable rsEdit.MoveFirst cboEdit(IndexD).Clear Do While Not rsEdit.EOF cboEdit(IndexD).AddItem rsEdit.Fields(IndexS) rsEdit.MoveNext Loop cboEdit(IndexD).Refresh rsEdit.Close 'lbl: End Sub Private Sub AddcboStreet() Dim SQL As String Set rsEdit = New ADODB.Recordset SQL = "select * from Tbl_Street where District = '" & cboEdit(2).Text & "';" rsEdit.Open SQL, cnNet, adOpenDynamic, adLockPessimistic, adCmdText rsEdit.MoveFirst cboEdit(1).Clear Do While Not rsEdit.EOF cboEdit(1).AddItem rsEdit.Fields(2) rsEdit.MoveNext Loop cboEdit(1).Refresh rsEdit.Close End Sub Private Sub UpdateEdit(ByVal Index As Byte, tbl As String) Dim rsUpdate As ADODB.Recordset Dim temp As Integer 'On Error Resume Next Set rsUpdate = New ADODB.Recordset rsUpdate.Open tbl, cnNet, adOpenDynamic, adLockPessimistic, adCmdTable If flagStreet = True Then temp = 2 Else temp = 1 End If Select Case Index Case 0 rsUpdate.AddNew If Not flagStreet Then rsUpdate.Fields(1) = txtEditContent.Text Else rsUpdate.Fields(1) = cboEdit(2).Text rsUpdate.Fields(2) = txtEditContent.Text End If rsUpdate.Update flagStreet = False Case 1 rsUpdate.MoveFirst Do While Not rsUpdate.EOF If rsUpdate.Fields(temp) = cboEdit(1).Text Then If Not flagStreet Then rsUpdate.Fields(1) = txtEditContent.Text Else rsUpdate.Fields(1) = cboEdit(2).Text rsUpdate.Fields(2) = txtEditContent.Text End If rsUpdate.Update flagStreet = False Exit Sub End If rsUpdate.MoveNext Loop End Select End Sub Private Sub DeleteEdit() Dim rsUpdate As ADODB.Recordset Set rsUpdate = New ADODB.Recordset rsUpdate.Open tblEdit, cnNet, adOpenDynamic, adLockPessimistic, adCmdTable rsUpdate.MoveFirst Do While Not rsUpdate.EOF If rsUpdate.Fields(1) = cboEdit(1).Text Then rsUpdate.Delete Exit Sub End If rsUpdate.MoveNext Loop End Sub Private Sub DispDatagrid() Dim rsBackup As ADODB.Recordset Dim R As Long, i As Integer ' On Error GoTo lbl Set rsBackup = New ADODB.Recordset rsBackup.Open "Tbl_Backup", cnNet, adOpenKeyset, _ adLockPessimistic, adCmdTable With fgridBackup 'Text in header .row = 0 .Col = 0 .Text = "Code" .CellAlignment = 1 .Col = 1 .Text = "Backup" .Col = 2 .Text = "Time" .Col = 3 .Text = "Type Database" .rows = rsBackup.RecordCount + 1 rsBackup.MoveFirst R = 1 Do While Not rsBackup.EOF For i = 0 To 3 If Not IsNull(rsBackup.Fields(i)) Then .TextMatrix(R, i) = rsBackup.Fields(i) Else .TextMatrix(R, i) = "" End If Next i rsBackup.MoveNext R = R + 1 Loop End With 'lbl: End Sub Private Sub SizeGrid() With fgridBackup .ColS = 4 .ColWidth(0) = 1000 .ColWidth(1) = 1200 .ColWidth(2) = 1200 .ColWidth(3) = 1550 .ColAlignment(0) = 1 End With End Sub Private Sub backup() Dim rsBackup As ADODB.Recordset Dim TypeData As String Dim fso As New FileSystemObject Dim Nfile As File, Sfile As File Dim num As String Dim Flag As Boolean 'Kiem tra xem typedata co dung theo yeu cau hay khong Set rsBackup = New ADODB.Recordset rsBackup.Open "Tbl_Backup", cnNet, adOpenDynamic, _ adLockPessimistic, adCmdTable Set Nfile = fso.GetFile(netPathDir + "Database\nhadatdatabase.mdb") Set Sfile = fso.GetFile(netPathDir + "Database\serverdatabase.mdb") rsBackup.MoveLast num = CStr(rsBackup.Fields(0) + 1) If chkPath.Value = 0 Then TypeData = "ALL" Nfile.Copy (netPathDir + "Backup\N" + num + ".mdb") Sfile.Copy (netPathDir + "Backup\S" + num + ".mdb") Else If txtBPath.Text = "" Then MsgBox "Files can't not Save." + Chr(13) + _ "Select file carefully, please !", vbOKOnly, "Warning" cmdBackupBrow.SetFocus Exit Sub End If If InStr(1, txtBPath.Text, "ServerDatabase.mdb", vbTextCompare) 0 Then TypeData = "ServerDatabase" Sfile.Copy (netPathDir + "Backup\S" + num + ".mdb") Flag = True End If If InStr(1, txtBPath.Text, "nhadatDatabase.mdb", vbTextCompare) 0 Then TypeData = "nhadatDatabase" Nfile.Copy (netPathDir + "Backup\N" + num + ".mdb") Flag = True End If If Not Flag Then MsgBox "You only can select nhadatDatabase or " & _ "ServerDatabase for backup !", vbOKOnly, "Warning !" cmdBackupBrow.SetFocus Exit Sub End If End If With rsBackup .AddNew .Fields(1) = Date .Fields(2) = Time .Fields(3) = TypeData .Update End With End Sub Private Sub chkPathE(ByVal Flag As Boolean) txtBPath.Enabled = Flag cmdBackupBrow.Enabled = Flag lblBackupPath.Enabled = Flag fgridBackup.Enabled = Not Flag End Sub Private Sub DelFile(ByVal Index As Long, TypeData As String) '==========Delete file in backup ============= Dim fso As New FileSystemObject Dim Nfile As File, Sfile As File On Error Resume Next Select Case TypeData Case "nhadatDatabase" Set Nfile = fso.GetFile(netPathDir + "Backup\N" + CStr(Index) + ".mdb") Nfile.Delete Case "ServerDatabase" Set Sfile = fso.GetFile(netPathDir + "Backup\S" + CStr(Index) + ".mdb") Sfile.Delete Case "ALL" Set Nfile = fso.GetFile(netPathDir + "Backup\N" + CStr(Index) + ".mdb") Nfile.Delete Set Sfile = fso.GetFile(netPathDir + "Backup\S" + CStr(Index) + ".mdb") Sfile.Delete End Select End Sub Private Sub UpdateRate() Dim rsrate As New ADODB.Recordset rsrate.Open "Tbl_Transfer_Rate", cnNet, _ adOpenKeyset, adLockPessimistic, adCmdTable With rsrate .MoveFirst .Fields(2) = CDbl(1 / txtUSD.Text) .Update .MoveNext .Fields(2) = CDbl(txtTofGold.Text / txtUSD.Text) .Update End With End Sub Private Sub DispRate() txtUSD.Text = Round(1 / VND) txtTofGold.Text = Round(TofGold / VND) End Sub Private Sub txtTofGold_Change() flagRate = True End Sub Private Sub txtUSD_Change() flagRate = True End Sub