unit class_patinet; interface uses SysUtils, Classes, Dialogs, DataUnit, ConstUnit, DB, check_user_data, user_types; type TPatient = class (TObject) private info: TPatinet_record; //Полная информация function make_insert_query(): TQuery_results; function make_update_query(): TQuery_results; function make_delete_query(): TQuery_results; function check_paient_info(): TQuery_results; function get_measure_count( in_ID_patient: string ): integer; function get_measures_array( in_ID_patient: string; in_measures_count: integer ): TMeasure_info_array; public //номер строчки в таблице table_string_num: integer; constructor Create; destructor Destroy; override; //Процедуры и функции на выход function Get_patient_by_id( in_ID_patient: string ): TPatinet_record; function Get_current_patient(): TPatinet_record; function Get_current_patient_ID(): string; function Get_current_patient_sirname(): string; function Get_current_patient_first_name(): string; function Get_current_patient_middle_name(): string; function Get_current_patient_birth_day(): string; function Get_current_patient_birth_month(): string; function Get_current_patient_birth_year(): string; function Get_current_patient_description(): TStrings; function Get_current_patient_measure_count(): string; function Get_current_patient_measures_array(): TMeasure_info_array; function Get_current_patient_short_full_name: string; //Процедуры и функции на вход procedure Set_current_patient_by_id( in_ID_patient: string ); procedure Set_current_patient_sirname ( in_sirname: string ); procedure Set_current_patient_first_name ( in_first_name: string ); procedure Set_current_patient_middle_name ( in_middle_name: string ); procedure Set_current_patient_birth_day ( in_birth_day: string ); procedure Set_current_patient_birth_month ( in_birth_month: string ); procedure Set_current_patient_birth_year ( in_birth_year: string ); procedure Set_current_patient_description ( in_description: TStrings ); //Процедуры и функции работы с базой function Insert_current_patient (): boolean; function Update_current_patient (): boolean; function Delete_current_patient (): boolean; protected { protected declarations } end; implementation constructor TPatient.Create; begin inherited; with self.info do begin sirname:= ''; first_name:= ''; middle_name:= ''; birth_day:= ''; birth_month:= ''; birth_year:= ''; description := TStringList.Create; measure_count := 0; SetLength( measures, 0 ); end; table_string_num := 1; //указатель на 1-ую строчку в таблице end; destructor TPatient.Destroy; begin with self.info do begin sirname := ''; first_name := ''; middle_name := ''; birth_day := ''; birth_month := ''; birth_year := ''; description.Destroy; measure_count := 0; SetLength( measures, 0 ); end; self.Free; end; {$REGION 'Процедуры и функции на выход'} function TPatient.Get_patient_by_id( in_ID_patient: string): TPatinet_record; begin //на выход идет запись о пациенте Assert( ( strtoint(in_ID_patient) > 0 ), 'ID_pateint отрицателен! Вызов Patient.Get_patient_by_id' + '{B7A56E59-0103-4E01-90A5-788B005D6ADF}'); mysql_query( SQL_DM.mysql_query1, 'CALL rd_patient_select_by_id(' + '''' + in_ID_patient + '''' + ');', 2 ); if ( SQL_DM.mysql_query1.RecordCount > 0 ) then begin result.ID:= SQL_DM.mysql_query1.FieldByName( 'id' ).AsString; result.sirname:= SQL_DM.mysql_query1.FieldByName( 'fam' ).AsString; result.first_name:= SQL_DM.mysql_query1.FieldByName( 'name' ).AsString; result.middle_name:= SQL_DM.mysql_query1.FieldByName( 'otch' ).AsString; result.birth_day:= convert_day(SQL_DM.mysql_query1.FieldByName( 'day' ).AsInteger); result.birth_month:= convert_day(SQL_DM.mysql_query1.FieldByName( 'mon' ).AsInteger); result.birth_year:= SQL_DM.mysql_query1.FieldByName( 'year').AsString; //bmRead, bmWrite, bmReadWrite result.description := TStringList.Create; result.description.LoadFromStream( SQL_DM.mysql_query1.CreateBlobStream( SQL_DM.mysql_query1.FieldByName( 'opisanie' ), bmRead) ); end else begin //обработка ошибки несуществующего пользователя end; //количество измерений result.measure_count := get_measure_count( in_ID_patient ); //массив измерений result.measures := get_measures_array( in_ID_patient, result.measure_count); end; function TPatient.Get_current_patient(): TPatinet_record; begin Assert( ( not (self.info.id = '') ), 'поле записи пациента ID пустое! Вызов Patient.Get_current_patient_ID'+'{79A05F49-79DB-4EF1-B4E7-2ED030696BB3}'); result.ID := self.info.ID; Assert( ( not (self.info.sirname = '') ), 'поле записи пациента ФАМИЛИЯ (sirname) пустое! Вызов Patient.Get_current_patient_sirname'+'{51601B41-B7DF-4A41-8B1D-3F2B5466561A}'); result.sirname := self.info.sirname; Assert( ( not (self.info.first_name='') ), 'поле записи пациента ИМЯ (first_name) пустое! Вызов Patient.Get_current_patient_first_name'+'{58F78E42-7003-46D5-8FF2-E44F920B9A7B}'); result.first_name := self.info.first_name; Assert( ( not (self.info.middle_name='') ), 'поле записи пациента ОТЧЕСТВО (middle_name) пустое! Вызов Patient.Get_current_patient_middle_name'+'{64E7AA23-08CE-437F-B968-6CA419BC6FC4}'); result.middle_name := self.info.middle_name; Assert( ( ( strtoint( self.info.birth_day ) > 0) and ( strtoint( self.info.birth_day ) < 32) ), 'поле записи пациента ДЕНЬ РОЖДЕНИЯ (birth_day) вышло за пределы диапазона! Вызов Patient.Get_current_patient_birth_day'+'{7F46DE3F-1CAD-4937-9FCD-148FCC0E2F71}'); result.birth_day := self.info.birth_day; Assert( ( ( strtoint( self.info.birth_month ) > 0) and ( strtoint( self.info.birth_month ) < 13) ), 'поле записи пациента МЕСЯЦ РОЖДЕНИЯ (birth_month) вышло за пределы диапазона! Вызов Patient.Get_current_patient_birth_month'+'{7CCB212F-FCCF-4319-A107-3E3E73837FCB}'); result.birth_month := self.info.birth_month; Assert( ( ( strtoint(self.info.birth_year ) < MAX_YEAR) and ( strtoint( self.info.birth_year ) > MIN_YEAR) ), 'поле записи пациента ГОД РОЖДЕНИЯ (birth_year) вышло за пределы диапазона! Patient.Get_current_patient_description'+'{D422CF34-7B9C-409B-A4DE-AEE996CB9773}'); result.birth_year := self.info.birth_year; Assert( ( self.info.measure_count < 0 ), 'поле записи пациента КОЛИЧЕСТВО ИЗМЕРЕНИЙ (measure_count) вышло за пределы диапазона! Patient.Get_current_patient_description'+'{24DCC82F-35D2-4DF3-8DDF-A95FD2263903}'); result.measure_count := self.info.measure_count; //массив измерений result.measures := self.info.measures; result.description := TStringList.Create; result.description := self.info.description; end; function TPatient.Get_current_patient_ID(): string; begin Assert( ( not ( self.info.id = '' ) ), 'поле записи пациента ID пустое! Вызов Patient.Get_current_patient_ID'+'{4FDE99A4-647A-485C-9754-E89D36C7DDE9}'); result := self.info.id; end; function TPatient.Get_current_patient_short_full_name: string; begin result := self.Get_current_patient_sirname + ' ' + (self.Get_current_patient_first_name)[1] + ' ' + (self.Get_current_patient_middle_name)[1]; end; function TPatient.Get_current_patient_sirname(): string; begin Assert( ( not ( self.info.sirname = '' ) ), 'поле записи пациента ФАМИЛИЯ (sirname) пустое! Вызов Patient.Get_current_patient_sirname'+'{84C9A431-E425-4C02-9A88-879A18D8B627}'); result := self.info.sirname; end; function TPatient.Get_current_patient_first_name(): string; begin Assert( ( not ( self.info.first_name = '' ) ), 'поле записи пациента ИМЯ (first_name) пустое! Вызов Patient.Get_current_patient_first_name'+'{8E22EB1E-44F7-4C99-9242-0E8738DF8CF6}'); result := self.info.first_name; end; function TPatient.Get_current_patient_middle_name(): string; begin Assert( ( not ( self.info.middle_name = '' ) ), 'поле записи пациента ОТЧЕСТВО (middle_name) пустое! Вызов Patient.Get_current_patient_middle_name'+'{0F4E1376-A6CB-459A-92F5-39724947ED76}'); result := self.info.middle_name; end; function TPatient.Get_current_patient_birth_day(): string; begin Assert( ( ( strtoint( self.info.birth_day ) > 0 ) and ( strtoint( self.info.birth_day ) < 32 ) ), 'поле записи пациента ДЕНЬ РОЖДЕНИЯ (birth_day) вышло за пределы диапазона! Вызов Patient.Get_current_patient_birth_day'+'{CE493B49-2D88-40A4-8AD0-C16A9D642AB9}'); result := self.info.birth_day; end; function TPatient.Get_current_patient_birth_month(): string; begin Assert( ( ( strtoint( self.info.birth_month ) > 0 ) and ( strtoint( self.info.birth_month ) < 13 ) ), 'поле записи пациента МЕСЯЦ РОЖДЕНИЯ (birth_month) вышло за пределы диапазона! Вызов Patient.Get_current_patient_birth_month'+'{C4A783FC-74ED-4D41-9C19-36E11CA71B85}'); result := self.info.birth_month; end; function TPatient.Get_current_patient_birth_year(): string; begin Assert( ( ( MIN_YEAR < strtoint( self.info.birth_year ) ) and ( strtoint( self.info.birth_year ) < MAX_YEAR ) ), 'поле записи пациента ГОД РОЖДЕНИЯ (birth_year) вышло за пределы диапазона! Patient.Get_current_patient_description'); result := self.info.birth_year; end; function TPatient.Get_current_patient_description(): TStrings; begin result := self.info.description; end; function TPatient.Get_current_patient_measure_count(): string; begin Assert( ( self.info.measure_count > -1 ), 'поле записи пациента КОЛИЧЕСТВО ИЗМЕРЕНИЙ (measure_count) вышло за пределы диапазона! Patient.Get_current_patient_description'+'{24DCC82F-35D2-4DF3-8DDF-A95FD2263903}'); result := inttostr( self.info.measure_count ); end; function TPatient.Get_current_patient_measures_array(): TMeasure_info_array; begin Assert( ( length( self.info.measures ) > 0 ), 'поле записи пациента МАССИВ ИЗМЕРЕНИЙ (measures) вышло за пределы диапазона! Patient.Get_current_patient_description'+'{13650234-9B1D-493C-A587-91332B3F7169}'); result := self.info.measures; end; //private. Получение числа измерений для пользователя function TPatient.Get_measure_count( in_ID_patient: string ): integer; begin result := 0; //количество измерений mysql_query(SQL_DM.mysql_query1, 'CALL rd_patinet_measure_count(' + '''' + in_ID_patient+'''' + ',@out_ErrorMessage, @out_Success, @out_measure_count);', 2); mysql_query(SQL_DM.mysql_query1, 'SELECT @out_measure_count;',2); if ( SQL_DM.mysql_query1.RecordCount > 0 ) then begin result := SQL_DM.mysql_query1.FieldByName( '@out_measure_count' ).AsInteger; // ДОБАВЛЕИЕ ОБРАБОТКИ ОШИБОК!!!!! end else begin //обработка ошибки несуществующего пользователя end; end; function TPatient.get_measures_array(in_ID_patient: string; in_measures_count: integer): TMeasure_info_array; var i: integer; begin SetLength( result, in_measures_count ); //массив измерений mysql_query( SQL_DM.mysql_query1, 'CALL rd_measure_get_info_by_patient(' + '''' + in_ID_patient + '''' + ',@out_ErrorMessage, @out_Success);', 2); if ( SQL_DM.mysql_query1.RecordCount > 0 ) then begin with SQL_DM.mysql_query1 do begin First; i := 0; while not Eof do begin result[ i ].ID := FieldByName( 'id' ).AsString; result[ i ].date := FieldByName( 'date' ).AsString; result[ i ].description := FieldByName( 'opisanie' ).AsString; inc( i ); Next; end; end; // ДОБАВЛЕИЕ ОБРАБОТКИ ОШИБОК!!!!! end else begin //обработка ошибки несуществующего пользователя end; end; {$ENDREGION } {$REGION 'Процедуры и функции на вход'} procedure TPatient.Set_current_patient_by_id( in_ID_patient: string ); begin Assert( ( strtoint( in_ID_patient ) > 0), 'ID_pateint отрицателен! Вызов Patient.Get_patient_by_id'+'{430A1CA0-5923-489A-8843-1869EA16DDD6}'); //общая информация mysql_query( SQL_DM.mysql_query1, 'CALL rd_patient_select_by_id(' + '''' + in_ID_patient + '''' + ');', 2); if ( SQL_DM.mysql_query1.RecordCount > 0 ) then begin self.info.id := SQL_DM.mysql_query1.FieldByName( 'id' ).AsString; self.info.sirname := SQL_DM.mysql_query1.FieldByName( 'fam' ).AsString; self.info.first_name := SQL_DM.mysql_query1.FieldByName( 'name' ).AsString; self.info.middle_name := SQL_DM.mysql_query1.FieldByName( 'otch' ).AsString; self.info.birth_day := convert_day(SQL_DM.mysql_query1.FieldByName( 'day' ).AsInteger); self.info.birth_month := convert_month(SQL_DM.mysql_query1.FieldByName( 'mon' ).AsInteger); self.info.birth_year := SQL_DM.mysql_query1.FieldByName( 'year' ).AsString; //bmRead, bmWrite, bmReadWrite self.info.description.LoadFromStream( SQL_DM.mysql_query1.CreateBlobStream( SQL_DM.mysql_query1.FieldByName( 'opisanie' ), bmRead ) ); end else begin //обработка ошибки несуществующего пользователя end; //количество измерений self.info.measure_count := get_measure_count( in_ID_patient ); //массив измерений self.info.measures := get_measures_array( in_ID_patient, self.info.measure_count ); end; procedure TPatient.Set_current_patient_sirname( in_sirname: string); var temp_string:string; begin temp_string := user_data_check_and_correct_name( in_sirname ); if ( self.info.sirname = temp_string ) then begin Exit; end else begin self.info.sirname := temp_string; end; end; procedure TPatient.Set_current_patient_first_name( in_first_name: string ); var temp_string: string; begin temp_string := user_data_check_and_correct_name( in_first_name ); if self.info.first_name = temp_string then begin Exit; end else begin self.info.first_name := temp_string; end; end; procedure TPatient.Set_current_patient_middle_name( in_middle_name: string ); var temp_string: string; begin temp_string := user_data_check_and_correct_name( in_middle_name ); if ( self.info.middle_name = temp_string ) then begin Exit; end else begin self.info.middle_name := temp_string; end; end; procedure TPatient.Set_current_patient_birth_day( in_birth_day: string ); var temp_string:string; begin temp_string := user_data_check_and_correct_day( in_birth_day ); if ( self.info.birth_day = temp_string ) then begin Exit; end else begin self.info.birth_day := temp_string; end; end; procedure TPatient.Set_current_patient_birth_month( in_birth_month: string ); var temp_string: string; begin temp_string := user_data_check_and_correct_month( in_birth_month ); if ( self.info.birth_month = temp_string ) then begin Exit; end else begin self.info.birth_month := temp_string; end; end; procedure TPatient.Set_current_patient_birth_year( in_birth_year: string ); var temp_string: string; begin temp_string := user_data_check_and_correct_year( in_birth_year ); if ( self.info.birth_year = temp_string ) then begin Exit; end else begin self.info.birth_year := temp_string; end; end; procedure TPatient.Set_current_patient_description( in_description: TStrings ); begin if ( self.info.description = in_description ) then begin Exit; end else begin self.info.description := in_description; end; end; {$ENDREGION} {$REGION 'Процедуры и функции для БД'} function TPatient.Insert_current_patient(): boolean; var data_correct: boolean; AQuery_results: TQuery_results; begin result := false; //Проверка на корректность информации data_correct := check_paient_info.Success; if data_correct then begin AQuery_results := make_insert_query(); if AQuery_results.Success then begin result := true; end else begin result := false; //показ ошибки пользователю showmessage ( AQuery_results.Error_message ); end; end; end; function TPatient.make_insert_query(): TQuery_results; var insert_stream: TStringStream; begin with SQL_DM.mysql_query_sp do begin try Close; SQL.Text := 'CALL rd_patient_insert(:in_Sirname, :in_Name, :in_MiddleName,'+ ':in_BirthDay, :in_BirthMonth, :in_BirthYear, :in_PatientInfo'+ ', @out_Success, @out_ErrorMessage);'; Prepare; Params.ParamByName( 'in_Sirname' ).Value := self.info.sirname; Params.ParamByName( 'in_Name' ).Value := self.info.first_name; Params.ParamByName( 'in_MiddleName' ).Value := self.info.middle_name; Params.ParamByName( 'in_BirthDay' ).Value := self.info.birth_day; Params.ParamByName( 'in_BirthMonth' ).Value := self.info.birth_month; Params.ParamByName( 'in_BirthYear' ).Value := self.info.birth_year; //создание потока и запись в него инфы из мемо insert_stream := TStringStream.Create(); self.info.description.SaveToStream( insert_stream ); ParamByName( 'in_PatientInfo' ).LoadFromStream( insert_stream, ftMemo ); insert_stream.Free; Execute; except on E: Exception do begin Result.Success := FALSE; Result.Error_message := E.Message; Exit; end; end; try Close; //выборка выходных переменных процедуры SQL.Clear; SQL.Text := 'SELECT @out_Success, @out_ErrorMessage;'; Execute; except on E: Exception do begin Result.Success := FALSE; Result.Error_message := E.Message; Exit; end; end; Result.Success := strtobool( FieldByName( '@out_Success' ).AsString ); Result.Error_message := ( FieldByName( '@out_ErrorMessage' ).AsString ); Exit; end; end; function TPatient.Update_current_patient(): boolean; var data_correct: boolean; AQuery_results: TQuery_results; begin result := false; //Проверка на корректность информации data_correct := check_paient_info.Success; if data_correct then begin AQuery_results := make_update_query(); if AQuery_results.Success then begin result := true; end else begin result := false; //показ ошибки пользователю showmessage( AQuery_results.Error_message ); end; end; end; function TPatient.make_update_query():TQuery_results; var insert_stream: TStringStream; begin with SQL_DM.mysql_query_sp do begin try Close; SQL.Text := 'CALL rd_patient_update(:in_ID, :in_Sirname, :in_Name, :in_MiddleName,'+ ':in_BirthDay, :in_BirthMonth, :in_BirthYear, :in_PatientInfo'+ ', @out_Success, @out_ErrorMessage);'; Prepare; Params.ParamByName( 'in_ID' ).Value := self.info.ID; Params.ParamByName( 'in_Sirname' ).Value := self.info.sirname; Params.ParamByName( 'in_Name' ).Value := self.info.first_name; Params.ParamByName( 'in_MiddleName' ).Value := self.info.middle_name; Params.ParamByName( 'in_BirthDay' ).Value := self.info.birth_day; Params.ParamByName( 'in_BirthMonth' ).Value := self.info.birth_month; Params.ParamByName( 'in_BirthYear' ).Value := self.info.birth_year; //создание потока и запись в него инфы из мемо insert_stream := TStringStream.Create(); self.info.description.SaveToStream( insert_stream ); ParamByName( 'in_PatientInfo' ).LoadFromStream( insert_stream, ftMemo ); insert_stream.Free; Execute; except on E: Exception do begin Result.Success := FALSE; Result.Error_message := E.Message; Exit; end; end; try Close; //выборка выходных переменных процедуры SQL.Clear; SQL.Text := 'SELECT @out_Success, @out_ErrorMessage;'; Execute; except on E: Exception do begin Result.Success := FALSE; Result.Error_message := E.Message; Exit; end; end; //showmessage(FieldByName('@out_Success').AsString); Result.Success := strtobool( FieldByName( '@out_Success' ).AsString ); Result.Error_message := ( FieldByName( '@out_ErrorMessage' ).AsString ); Exit; end; end; function TPatient.Delete_current_patient(): boolean; var AQuery_results: TQuery_results; begin AQuery_results := make_delete_query(); if AQuery_results.Success then begin result := true; end else begin result := false; //показ ошибки пользователю showmessage( AQuery_results.Error_message ); end; end; function TPatient.make_delete_query(): TQuery_results; begin with SQL_DM.mysql_query_sp do begin try Close; SQL.Text := 'CALL rd_patient_delete(:in_ID'+ ', @out_Success, @out_ErrorMessage);'; Prepare; Params.ParamByName( 'in_ID' ).Value := self.info.ID; Execute; except on E: Exception do begin Result.Success := FALSE; Result.Error_message := E.Message; Exit; end; end; try Close; //выборка выходных переменных процедуры SQL.Clear; SQL.Text := 'SELECT @out_Success, @out_ErrorMessage;'; Execute; except on E: Exception do begin Result.Success := FALSE; Result.Error_message := E.Message; Exit; end; end; //showmessage(FieldByName('@out_Success').AsString); Result.Success := strtobool( FieldByName( '@out_Success' ).AsString ); Result.Error_message := ( FieldByName( '@out_ErrorMessage' ).AsString ); Exit; end; end; {$ENDREGION 'Процедуры и функции для БД'} function TPatient.check_paient_info:TQuery_results; begin result.Success := true; result.Error_message := ''; //проверяем все ли в порядке с данными обязательными для указания, нет ли пустых if ( user_data_check_and_correct_name( Self.info.sirname ) = '' ) then begin result.Success := false; result.Error_message := 'Поле фамилия пустое'; end; if ( user_data_check_and_correct_name( Self.info.first_name ) = '' ) then begin result.Success := false; result.Error_message := 'Поле имени пустое'; end; if ( user_data_check_and_correct_name( Self.info.middle_name ) = '' ) then begin result.Success := false; result.Error_message := 'Поле отчества пустое'; end; if ( user_data_check_and_correct_day( Self.info.birth_day ) = '' ) then begin result.Success := false; result.Error_message := 'Поле дня рождения пустое'; end; if ( user_data_check_and_correct_month(Self.info.birth_month) = '' ) then begin result.Success := false; result.Error_message := 'Поле месяца рождения пустое'; end; if ( user_data_check_and_correct_year( Self.info.birth_year ) = '' ) then begin result.Success := false; result.Error_message := 'Поле года рождения пустое'; end; end; end.