Главное окно (листинг)

1 2 3 4 5 6 7

unit MainWindow;

interface

uses

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

Dialogs, StdCtrls, ExcelXP, OleServer, Buttons, ADODB, FileCtrl, Gauges, DB,

ShellAPI, XPMan, nrclasses, nratcmd, nrgsm, nrcomm, nrcommbox, ExtCtrls;

type

TMainForm = class(TForm)

DirPath: TEdit;

Browse: TBitBtn;

LogBtn: TBitBtn;

XL: TExcelApplication;

WB: TExcelWorkbook;

WS: TExcelWorksheet;

StaticText1: TStaticText;

ADOConnection1: TADOConnection;

ADOCommand1: TADOCommand;

ADOTable1: TADOTable;

SendBtn: TBitBtn;

ADOTable2: TADOTable;

ADOConnection2: TADOConnection;

ADOTable3: TADOTable;

XPManifest1: TXPManifest;

nrComm1: TnrComm;

nrGsm1: TnrGsm;

OpenHideBtn: TSpeedButton;

PupilsBtn: TButton;

MsgBtn: TButton;

procedure BrowseClick(Sender: TObject);

procedure LogBtnClick(Sender: TObject);

procedure SendBtnClick(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure OpenHideBtnClick(Sender: TObject);

procedure PupilsBtnClick(Sender: TObject);

procedure MsgBtnClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

Path:string;

FileList:array of string;

T:TDateTime;

Year:word;

SchoolList:array of string;

FormList: array of array of string;

implementation

uses DateUtils, ComUnit, StrUtils, DBWindow;

{$R *.dfm}

//Процедура задержки времени на dwMilliseconds милисекунд

//между отправками сообщений

procedure Delay(dwMilliseconds: word);

var

iStart, iStop: DWORD;

begin

iStart:= GetTickCount;

repeat

iStop:= GetTickCount;

Application.ProcessMessages;

until (iStop - iStart) >= dwMilliseconds;

end;

procedure TMainForm.BrowseClick(Sender: TObject);

begin

SelectDirectory('Выберите папку, содержащую электронные журналы',' ',Path);

DirPath.Text:=Path;

end;

{-------Создание сообщений--------}

procedure CreateMessages;

var

i, ID, n, j, x:integer;

S:string;

MyChar:char;

begin

//Открытие таблицы "Школы" в БД MainDB.mdb

MainForm.ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+GetCurrentDir+'\DataBases\MainDB.mdb;Persist Security Info=False';

MainForm.ADOConnection1.Open;

MainForm.ADOConnection1.BeginTrans;

MainForm.ADOTable1.TableName:='Школы';

MainForm.ADOTable1.Open;

MainForm.ADOTable1.First;

SetLength(FileList,0);

//Поиск БД учеников согласно таблице "Школы"

While not MainForm.ADOTable1.Eof do

begin

T:=Today;

for i:=1 to 4 do

begin

Year:=YearOf(T);

if i>2

then

Dec(Year);

S:=GetCurrentDir+'\DataBases\'+MainForm.ADOTable1.FieldByName('Школа').Value+'\'+MainForm.ADOTable1.FieldByName('Класс').Value+'\DB_'+IntToStr(i)+'_'+IntToStr(Year)+'.mdb';

if FileExists(S)

then

begin

SetLength(FileList,Length(FileList)+1);

//FileList:= Список_БД_учеников

FileList[High(FileList)]:=S;

end;

MainForm.ADOTable1.Next;

end;

MainForm.ADOTable1.Close;

//Открытие таблицы "Сообщения" в БД MainDB.mdb

MainForm.ADOTable1.TableName:='Сообщения';

MainForm.ADOTable1.Open;

//Цикл1

for i:=0 to High(FileList)do

begin

MainForm.ADOConnection2.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+FileList[i]+';Persist Security Info=False';

MainForm.ADOConnection2.Open;

MainForm.ADOConnection2.BeginTrans;

//Открытие таблицы "Ученики" в i-той БД учеников

MainForm.ADOTable2.TableName:='Ученики';

MainForm.ADOTable2.Open;

MainForm.ADOTable2.First;

//Цикл2

While not MainForm.ADOTable2.Eof do

begin

if MainForm.ADOTable1.IsEmpty

then

begin

MainForm.ADOTable1.Append;

MainForm.ADOTable1.FieldByName('ID').Value:=1;

end

else

begin

MainForm.ADOTable1.Last;

ID:=MainForm.ADOTable1.FieldByName('ID').Value;

Inc(ID);

MainForm.ADOTable1.Append;

MainForm.ADOTable1.FieldByName('ID').Value:=ID;

end;

//Формирование текста сообщения

MainForm.ADOTable1.FieldByName('Номер абонента').Value:=MainForm.ADOTable2.FieldByName('Телефон').Value;

S:=MainForm.ADOTable2.FieldByName('Имя').Value+#10;

MainForm.ADOTable3.TableName:=MainForm.ADOTable2.FieldByName('Фамилия').Value+' '+MainForm.ADOTable2.FieldByName('Имя').Value+' - '+MainForm.ADOTable2.FieldByName('Телефон').Value;

MainForm.ADOTable3.Open;

n:=0;

for j:=2 to MainForm.ADOTable3.FieldCount do

begin

S:=S+AnsiReplaceStr(MainForm.ADOTable3.Fields.FieldByNumber(j).FieldName,'/','.')+#10;

x:=0;

MainForm.ADOTable3.First;

While not MainForm.ADOTable3.Eof do

begin

MyChar:=#0;

if (Length(MainForm.ADOTable3.Fields.FieldByNumber(j).AsString)=2)

then

begin

MyChar:=MainForm.ADOTable3.Fields.FieldByNumber(j).AsString[2];

end;

if (MainForm.ADOTable3.Fields.FieldByNumber(j).Value<>null)and(MainForm.ADOTable3.Fields.FieldByNumber(j).Value<>'')

and(MyChar=#14)

then

begin

S:=S+MainForm.ADOTable3.FieldByName('Предмет').Value+'-'+MainForm.ADOTable3.Fields.FieldByNumber(j).AsString[1]+#10;

Inc(n);

Inc(x);

MainForm.ADOTable3.Edit;

MainForm.ADOTable3.Fields.FieldByNumber(j).Value:=MainForm.ADOTable3.Fields.FieldByNumber(j).AsString[1];

MainForm.ADOTable3.Post;

end;

MainForm.ADOTable3.Next;

end;

if x=0

then

S:=copy(S,1,Length(S)-Length(MainForm.ADOTable3.Fields.FieldByNumber(j).FieldName+#10));

end;

MainForm.ADOTable3.Close;

j:=Length(S);

While (S[j]=' ')or(S[j]=#10) do

begin

S:=copy(S,1,Length(S)-1);

Dec(j);

end;

MainForm.ADOTable1.FieldByName('Текст сообщения').Value:=S;

//есть новые оценки?

if n=0

then

MainForm.ADOTable1.Cancel

else

//Добавление записи в таблице "Сообщения"

MainForm.ADOTable1.Post;

MainForm.ADOTable2.Next;

end;

//конец Цикл2

MainForm.ADOTable2.Close;

MainForm.ADOConnection2.CommitTrans;

MainForm.ADOConnection2.Close;

end;

//конец Цикл1

MainForm.ADOTable1.Close;

MainForm.ADOConnection1.CommitTrans;

MainForm.ADOConnection1.Close;

end;

//Внесение оценок в БД

procedure TMainForm.LogBtnClick(Sender: TObject);

var

SR: TSearchRec;

i, j, r, c, x, y, ID:integer;

Range: ExcelRange;

Matrix: array of array of string;

School, Form, Term:string;

Existing:boolean;

Progress: TGauge;

StaticText: TStaticText;

Label1_: TLabel;

Label2_: TLabel;

begin

//---Изменение размера окна

i:=ClientHeight;

Constraints.MaxHeight:=311;

ClientHeight:=i+111;

StaticText:=TStaticText.Create(MainForm);

with StaticText do

begin

Font.Size:=10;

Font.Style:=[fsBold];

Caption:='Подождите, идёт добавленние данных. Это может занять несколько минут';

Top:=i+8;

Left:=7;

Height:=33;

Width:=321;

Alignment:=taCenter;

AutoSize:=true;

Parent:=MainForm;

end;

Label1_:=TLabel.Create(Self);

with Label1_ do

begin

Font.Size:=10;

Top:=i+48;

Left:=24;

Caption:='Добавляется файл';

AutoSize:=true;

Parent:=Self;

end;

Label2_:=TLabel.Create(Self);

with Label2_ do

begin

Font.Size:=10;

Top:=i+48;

Left:=152;

AutoSize:=true;

Parent:=Self;

end;

Progress:=TGauge.Create(Self);

with Progress do

begin

Top:=i+72;

Left:=16;

Height:=25;

Width:=MainForm.ClientWidth-32;

ForeColor:=$66cc66;

Parent:=Self;

end;

Progress.PercentDone;

Progress.AddProgress(0);

MainForm.Refresh;

//---

//---Поиск электронных журналов по указанному пути

Path:=DirPath.Text;

if Path[Length(Path)]='\'

then

Path:=Path

else

Path:=Path+'\';

SetLength(FileList,0);

if FindFirst(Path + '*.xls', faAnyFile, SR) = 0 then

begin

repeat

if (SR.Attr <> faDirectory) then

begin

SetLength(FileList,Length(FileList)+1);

//FileList:=Список_электронных_журналов

FileList[High(FileList)]:=SR.Name;

end;

until FindNext(SR) <> 0;

FindClose(SR);

end;

//Цикл1

for i:=0 to High(FileList)do

begin

T:=Today;

Label2_.Caption:=FileList[i];

MainForm.Refresh;

Term:=FileList[i];

School:=copy(Term,1,pos('_',Term)-1);

Term:=copy(Term,pos('_',Term)+1,Length(Term)-pos('_',Term));

Form:=copy(Term,1,pos('_',Term)-1);

Term:=copy(Term,pos('_',Term)+1,pos('.',Term)-pos('_',Term)-1);

Year:=YearOf(T);

if (Term='3')or(Term='4')

then

Dec(Year);

//Папка "Школа\Класс" существует?

if not

FileExists(GetCurrentDir+'\DataBases\'+School+'\'+Form+'\DB_'+Term+'_'+IntToStr(Year)+'.mdb')

then

begin

if not DirectoryExists(GetCurrentDir+'\DataBases\'+School+'\'+Form)

then

begin

if not FileExists(GetCurrentDir+'\DataBases\MainDB.mdb')

then

CopyFile(PChar(GetCurrentDir+'\DataBases\Base\MainDB.mdb'),PChar(GetCurrentDir+'\DataBases\MainDB.mdb'),false);

//Создание папки "Школа\Класс"

CreateDir(GetCurrentDir+'\DataBases\'+School);

CreateDir(GetCurrentDir+'\DataBases\'+School+'\'+Form);

ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+GetCurrentDir+'\DataBases\MainDB.mdb;Persist Security Info=False';

ADOConnection1.Open;

ADOConnection1.BeginTrans;

//Добавление записи в таблице "Школы" в MainDB.mdb

ADOTable1.TableName:='Школы';

ADOTable1.Open;

ADOTable1.Append;

ADOTable1.FieldByName('Школа').Value:=School;

ADOTable1.FieldByName('Класс').Value:=Form;

ADOTable1.Post;

ADOTable1.Close;

ADOConnection1.CommitTrans;

ADOConnection1.Close;

end;

CopyFile(PChar(GetCurrentDir+'\DataBases\Base\DataBase.mdb'),PChar(GetCurrentDir+'\DataBases\'+School+'\'+Form+'\DB_'+Term+'_'+IntToStr(Year)+'.mdb'),false);

end;

//Открытие файла DB_ч_год.mdb

ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+GetCurrentDir+'\DataBases\'+School+'\'+Form+'\DB_'+Term+'_'+IntToStr(Year)+'.mdb;Persist Security Info=False';

ADOConnection1.Open;

ADOConnection1.BeginTrans;

//Открытие i-ого электронного журнала

WB.ConnectTo(XL.Workbooks.Open(

Path+FileList[i],

False,;

EmptyParam,

False,

EmptyParam,

0));

//Цикл2

for j:=1 to WB.Sheets.Count do

begin

SetLength(Matrix,0,0);

WS.ConnectTo(WB.Worksheets[j] as _WorkSheet);

Range:= WS.Range['A1', EmptyParam].SpecialCells(xlCellTypeLastCell, EmptyParam);

SetLength(Matrix,Range.Row,Range.Column);

for r:=0 to High(Matrix)do

for c:=0 to High(Matrix[r])do

Matrix[r,c]:=WS.Cells.Item[r+1,c+1];

y:=0;

for r:=High(Matrix) downto 0 do

begin

x:=0;

for c:=0 to High(Matrix[r])do

if Matrix[r,c]=''

then

Inc(x);

if x=Length(Matrix[r])

then

Inc(y)

else

break;

end;

x:=0;

for r:=High(Matrix[0])downto 0 do

if Matrix[0,r]=''

then

Inc(x)

else

break;

SetLength(Matrix,Length(Matrix)-y,Length(Matrix[0])-x);

for r:=1 to High(Matrix)do

begin

x:=0;

for c:=High(Matrix[r])downto 0 do

if Matrix[r,c]=''

then

Inc(x)

else

break;

SetLength(Matrix[r],Length(Matrix[r])-x);

end;

//Цикл3

for x:=1 to High(Matrix)do

begin

try

ADOTable1.TableName:=Matrix[x,1]+' - '+Matrix[x,0];

ADOTable1.Open;

except

ADOTable1.TableName:='Ученики';

ADOTable1.Open;

if ADOTable1.IsEmpty

then

begin

ADOTable1.Append;

ADOTable1.FieldByName('ID').Value:=1;

end

else

begin

ADOTable1.Last;

ID:=ADOTable1.FieldByName('ID').Value;

Inc(ID);

ADOTable1.Append;

ADOTable1.FieldByName('ID').Value:=ID;

end;

//Добавление записи в таблицу "Ученики"

ADOTable1.FieldByName('Фамилия').Value:=copy(Matrix[x,1],1,pos(' ',Matrix[x,1])-1);

ADOTable1.FieldByName('Имя').Value:=copy(Matrix[x,1],pos(' ',Matrix[x,1])+1,Length(Matrix[x,1])-pos(' ',Matrix[x,1]));

ADOTable1.FieldByName('Телефон').Value:=Matrix[x,0];

ADOTable1.Post;

ADOTable1.Close;

//Создание таблицы "Фамилия_Имя - Телефон"

ADOCommand1.CommandText:='Create Table ['+

Matrix[x,1]+' - '+Matrix[x,0]+'] ([Предмет] varchar(30), ';

for y:=2 to High(Matrix[0])-1 do

ADOCommand1.CommandText:=ADOCommand1.CommandText+

'['+Matrix[0,y]+'] varchar(2), ';

ADOCommand1.CommandText:=ADOCommand1.CommandText+

'['+Matrix[0,High(Matrix[0])]+'] varchar(2))';

ADOCommand1.Execute;

//Открытие таблицы "Фамилия_Имя - Телефон"

ADOTable1.TableName:=Matrix[x,1]+' - '+Matrix[x,0];

ADOTable1.Open;

end;

ADOTable1.First;

Existing:=false;

//---Внесение оценок в таблицу

While not ADOTable1.Eof do

begin

if ADOTable1.FieldByName('Предмет').Value=WS.Name

then

begin

Existing:=true;

break;

end;

ADOTable1.Next;

end;

if Existing

then

begin

ADOTable1.Edit;

for y:=2 to High(Matrix[x]) do

if (ADOTable1.FieldByName(Matrix[0,y]).Value<>Matrix[x,y])

and(Matrix[x,y]<>'')

then

ADOTable1.FieldByName(Matrix[0,y]).Value:=Matrix[x,y]+#14;

ADOTable1.Post;

end

else

begin

ADOTable1.Append;

ADOTable1.FieldByName('Предмет').Value:=WS.Name;

for y:=2 to High(Matrix[x]) do

if Matrix[x,y]<>''

then

ADOTable1.FieldByName(Matrix[0,y]).Value:=Matrix[x,y]+#14;

ADOTable1.Post;

end;

ADOTable1.Close;

//---

end;

//конец Цикл3

Progress.AddProgress(Round(100/(Length(FileList)*WB.Sheets.Count)));

end;

//конец Цикл2

WB.Close;

ADOConnection1.CommitTrans;

ADOConnection1.Close;

end;

//конец Цикл1

//Изменение размера окна

Progress.AddProgress(100);

Progress.Destroy;

Label1_.Destroy;

Label2_.Destroy;

StaticText.Destroy;

ClientHeight:=ClientHeight-111;

Constraints.MaxHeight:=200;

CreateMessages; //Создание сообщений

MessageDlg('Данные успешно внесены',mtInformation,[mbOK],0);

end;

{-------Отправка сообщений--------}

procedure TMainForm.SendBtnClick(Sender: TObject);

var

S1,S2:string;

S:WideString;

start,n,i:integer;

begin

MainForm.nrComm1.Active:=true;

ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+GetCurrentDir+'\DataBases\MainDB.mdb;Persist Security Info=False';

ADOConnection1.Open;

ADOConnection1.BeginTrans;

//Открытие таблицы "Сообщения" в MainDB.mdb

ADOTable1.TableName:='Сообщения';

ADOTable1.Open;

ADOTable1.First;

start:=0;

//Цикл1

While not ADOTable1.Eof do

begin

//Сообщение отправлено?

if not ADOTable1.FieldByName('Статус отправки').AsBoolean

then

begin

if (ADOTable1.FieldByName('Номер абонента').Value<>'')or(ADOTable1.FieldByName('Номер абонента').Value<>null)

then

begin

S1:=ADOTable1.FieldByName('Номер абонента').Value;

S:=ADOTable1.FieldByName('Текст сообщения').Value;

n:=1;

if Length(S)>69

then

n:=(Length(S) div 69)+1;

if ((Length(S)+n*4)div 69)>(n-1)

then

Inc(n);

if n>1

then

for i:=1 to n do

begin

S:=IntToStr(i)+'/'+IntToStr(n)+#10+S;

S2:=copy(S,1,69);

S:=copy(S,70,Length(S)-69);

//Отправка сообщения абоненту

nrGsm1.SmsSend(S1,S2,false);

//Ожидание 15 секунд для отправки сообщения

Delay(15000);

end

else

begin

//Отправка сообщения абоненту

nrGsm1.SmsSend(S1,S,false);

//Ожидание 15 секунд для отправки сообщения

Delay(15000);

end;

ADOTable1.Edit;

ADOTable1.FieldValues['Статус отправки']:=true;

ADOTable1.FieldByName('Дата отправки').Value:=DateToStr(Today);

ADOTable1.UpdateRecord;

ADOTable1.Post;

end;

Inc(Start);

end;

ADOTable1.Next;

end;

//конец Цикл1

ADOTable1.Close;

ADOConnection1.CommitTrans;

ADOConnection1.Close;

//N сообщений отправлено

MessageDlg('Отправлено сообщений:'+IntToStr(start)+'.',mtInformation,[mbOK],0);

end;

procedure TMainForm.FormShow(Sender: TObject);

begin

Form1.ShowModal;

OpenHideBtn.Caption:=#134;

end;

procedure TMainForm.OpenHideBtnClick(Sender: TObject);

var

i:integer;

begin

i:=Width;

if OpenHideBtn.Left=320 then

begin

Constraints.MaxWidth:=474;

Width:=i+100;

OpenHideBtn.Left:=420;

OpenHideBtn.Layout:=blGlyphRight;

OpenHideBtn.Caption:=#133;

PupilsBtn.Visible:=true;

MsgBtn.Visible:=true;

end

else

begin

Constraints.MaxWidth:=374;

OpenHideBtn.Left:=320;

OpenHideBtn.Top:=0;

Width:=i-100;

OpenHideBtn.Layout:=blGlyphLeft;

OpenHideBtn.Caption:=#134;

PupilsBtn.Visible:=false;

MsgBtn.Visible:=false;

end;

procedure TMainForm.PupilsBtnClick(Sender: TObject);

var

i,j:integer;

Exist:boolean;

begin

DBForm.Caption:='База данных Ученики';

DBForm.HeaderLbl.Caption:='Введите необходимую информацию';

DBForm.HeaderLbl.Visible:=true;

DBForm.YearEdit.Visible:=true;

DBForm.YearLbl.Visible:=true;

DBForm.TermEdit.Visible:=true;

DBForm.TermLbl.Visible:=true;

DBForm.SchoolCBox.Visible:=true;

DBForm.SchoolLbl.Visible:=true;

DBForm.FormCBox.Visible:=true;

DBForm.FormLbl.Visible:=true;

DBForm.PupilCBox.Visible:=true;

DBForm.PupilLbl.Visible:=true;

DBForm.TermEdit.Enabled:=false;

DBForm.SchoolCBox.Enabled:=false;

DBForm.FormCBox.Enabled:=false;

DBForm.PupilCBox.Enabled:=false;

DBForm.YearEdit.Text:='';

DBForm.TermEdit.Text:='';

DBForm.SchoolCBox.Clear;

DBForm.FormCBox.Clear;

DBForm.PupilCBox.Clear;

DBForm.Width:=672;

DBForm.Constraints.MaxWidth:=672;

DBForm.TextMsg.Visible:=false;

ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+GetCurrentDir+'\DataBases\MainDB.mdb;Persist Security Info=False';

ADOTable1.TableName:='Школы';

SetLength(SchoolList,0);

SetLength(FormList,0,0);

ADOTable1.Open;

ADOTable1.First;

While not ADOTable1.Eof do

begin

SetLength(SchoolList,Length(SchoolList)+1);

SetLength(FormList,Length(FormList)+1);

SchoolList[High(SchoolList)]:=ADOTable1.FieldByName('Школа').AsString;

While (ADOTable1.FieldByName('Школа').AsString=SchoolList[High(SchoolList)])and(not ADOTable1.Eof) do

begin SetLength(FormList[High(FormList)],Length(FormList[High(FormList)])+1); FormList[High(FormList),High(FormList[High(FormList)])]:=ADOTable1.FieldByName('Класс').AsString;

ADOTable1.Next;

end;

ADOTable1.Close;

DBForm.SchoolCBox.Clear;

for i:=0 to High(SchoolList)do

DBForm.SchoolCBox.Items.Add(SchoolList[i]);

DBForm.DBGrid1.ReadOnly:=true;

DBForm.DBGrid1.OnDrawDataCell:=DBForm.DBGrid1DrawDataCell1;

DBForm.ShowModal;

end;

procedure TMainForm.MsgBtnClick(Sender: TObject);

begin