Примеры кода, достойные орехов.

← →
Владислав © (2005-11-29 15:17) [0]

Нашел вот такой код в большом проекте.
Сохранено авторское форматирование кода. Комментарии мои.

//********************************************************************************** // Процедура увеличивает длину строки S до Len и добавляет в конец строки S пробелы. procedure UpdateLength(var S: string; Len: integer); var I: integer; begin for I := Length(S) + 1 to Len do S := S + " "; end; // Пример использования. // Выравниваем длину строк S1, S2 и S3, добавляя в конец строк пробелы. if S1 > S2 then MaxLen := Max(Length(S1), Length(S3)) else MaxLen := Max(Length(S2), Length(S3)); UpdateLength(S1, MaxLen); UpdateLength(S2, MaxLen); UpdateLength(S3, MaxLen); //********************************************************************************** // Ожидаем, пока пользователь не нажмет кнопку на немодальной форме while FProgress.ModalResult = mrNone do Application.ProcessMessages; //********************************************************************************** // Этот тип нам понадобится, чтобы добраться до protected свойства type TThreadAccess = class(TBaseAsyncRunThread); // Следующий код выполняет главный поток приложения. // Здесь проверяется (я бы сказал, кто-то хотел, чтобы проверялось) завершился ли дополнительный поток. // Свойство Terminated определено в TThread. Правда почему то protected. // Для проверки этого свойства и понадобился класс TThreadAccess. // Если Terminated = True, уничтожаем экземпляр класса, наследника TThread. // Если же Terminated = False, убиваем поток на сервере баз данных. // Процедуру Terminate при этом никто и не подумал вызвать. // Справедливости ради, надо заметить, что этот код работал. // Ни разу не было никаких исключений типа Access Violation, // а то, что при этом убивался серверный процесс - особенности реализации... if TThreadAccess(FThreadList[I]).Terminated then TBaseAsyncRunThread(FThreadList[I]).Free else begin TBaseAsyncRunThread(FThreadList[I]).ClearNotify; KillServerProcess(TBaseAsyncRunThread(FThreadList[I])); //********************************************************************************** // Ничего необычного. Объявлен тип метода. TMonitorEventProc = procedure(Connection: TADOConnection; const Sql, ErrMsg: string; IsStart: Boolean; RecsAff: Integer) of object; // Тоже ничего необычного. Глобальная переменная типа метод объекта. MonitorProc: TMonitorEventProc = nil; // Проверяем, присвоен ли наш обработчик неких событий глобальной переменной. // Если установлен, ничего не делаем, но событий ждем. // А то, что у методов есть еще какая-то там TMethod.Data - // пусть волнует тех, кто об этом знает. if @MonitorProc <> @TfmMonitor.MonitorEvent then begin MonitorProc := MonitorEvent; end; //**********************************************************************************

У кого есть что-то подобное, чтобы поделиться?..

P.S.: Почему-то этот код вместо улыбки вызывает разочарование и уныние :(

← →
Ega23 © (2005-11-29 15:21) [1]

function TfmMain.IncDay(const DateTime: TDateTime; NumberOfDays: Integer): TDateTime; {Функция предназначена для изменения даты (DateTime) путем добавления количества дней (NumberOfDays). Значение NumberOfDays может быть отрицательным.} var Y, M, D, CountDays: Word; N: Integer; Sign, NoBreak: Boolean; begin Sign := NumberOfDays >= 0; DecodeDate(DateTime, Y, M, D); N := NumberOfDays; NoBreak := True; if Sign then //Прибавить begin while(NoBreak) do begin //Количество дней в месяце CountDays := MonthDays[IsLeapYear(Y), M]; if (N + D) <= CountDays then //Если в пределах данного месяца begin Inc(D, N); NoBreak := False; end else begin if M < 12 then Inc(M, 1) else begin M := 1; Inc(Y, 1); end; N := N - (CountDays - D); D := 0; end; end; end else //Отнять begin N := -N; while(NoBreak) do begin if D > N then //Если в пределах данного месяца begin Dec(D, N); NoBreak := False; end else begin if M > 1 then Dec(M, 1) else begin M := 12; Dec(Y, 1); end; //Количество дней в месяце CountDays := MonthDays[IsLeapYear(Y), M]; N := N - D; D := CountDays; end; end; end; Result := EncodeDate(Y, M, D); //Установить время из старой даты ReplaceTime(Result, DateTime); end;

← →
Джо © (2005-11-29 15:22) [2]

> [1] Ega23 © (29.11.05 15:21)

8-()
Надеюсь, автора уже убили садистским способом или он все еще гуляет на свободе среди нас?!
:)

← →
Ega23 © (2005-11-29 15:24) [3]

> Надеюсь, автора уже убили садистским способом или он все
> еще гуляет на свободе среди нас?!

IncDay - это классика! Собственно говоря, я из-за неё на delphimaster ходить начал. Кто-то из приятелей ссылку прислал, чтобы поржать.
Текст уже года 3 висит на стенке. :о)

← →
Nikolay M. © (2005-11-29 15:25) [4]

> Ega23 © (29.11.05 15:21) [1]
> Владислав © (29.11.05 15:17)

Это все детский лепет.
Учу писать программы, дорого:
http://www.rsdn.ru/Forum/Message.aspx?mid=1320137&only=1

← →
Igorek © (2005-11-29 15:27) [5]

Ну про банер мелкософта я уже писал..

← →
Суслик © (2005-11-29 15:31) [6]

у меня полно такого, в основном собственной разработки.
работает 10й год, ну и слава богу :)

иногда бывают потуги отрефаторить чего-то.

но довести до конца времени нет, и, прямо скажем, резковыраженной необходимости.

← →
Lamer@fools.ua © (2005-11-29 15:31) [7]

Шо-то у всех так длинно. Я попроще встречал (VB.NET):

Public Function DoSomething() As Boolean Dim retValue As Boolean " Ту шо-то считаем If retValue = True Then Return True Else Return False End if End Function

← →
Ega23 © (2005-11-29 15:34) [8]

If retValue = True Then Return True Else if retValue = False then Return False End if

:о)

← →
Джо © (2005-11-29 15:34) [9]

> [4] Nikolay M. © (29.11.05 15:25)

:))))
Под столом.

← →
alex_*** © (2005-11-29 15:35) [10]

[7] это классика :) . Даже на собеседовании как-то попросили упростить что-то типа этого

← →
Nikolay M. © (2005-11-29 15:39) [11]

> Джо © (29.11.05 15:34) [9]

Был там же по прочтении. Каменты рулят :)

← →
Владислав © (2005-11-29 15:45) [12]

Таки вызвало улыбку :)
Нет худа без добра :)

← →
Digitman © (2005-11-29 15:50) [13]

Вот такой код я имел "удовольствие" узреть в проекте одного "реального пацана", всеръез водившего (и по сей день водящего) за нос одного из солидных заказчиков в Московии:

if (tp=TClass($7C509300)) or (tp=TClass($7D73E190)) or (tp=TClass($7D73C270)) or (tp=TClass($775E98D8))
then ...

это даже не столько орех, сколько диверсия)

← →
Джо © (2005-11-29 15:55) [14]

>
> [13] Digitman © (29.11.05 15:50)

Жестоко.

← →
Владислав © (2005-11-29 15:56) [15]

> это даже не столько орех, сколько диверсия)

Это уж точно диверсия!

← →
pasha_golub © (2005-11-29 15:56) [16]

> Digitman © (29.11.05 15:50) [13]

А шо оно делать должно? Не понимаю я, к сожалению

← →
Джо © (2005-11-29 15:57) [17]

> [13] Digitman © (29.11.05 15:50)

Он, надо полагать, ссылки менял после каждой модификации программы? Садомазо...

← →
Ega23 © (2005-11-29 15:57) [18]

> if (tp=TClass($7C509300)) or (tp=TClass($7D73E190)) or
> (tp=TClass($7D73C270)) or (tp=TClass($775E98D8))
> then ...
>

А как оно работает????

← →
Digitman © (2005-11-29 16:01) [19]

логика автора сего шедевра на редкость проста и убивает наповал (услышано прямо из его уст) - мол, у меня это работает, у заказчика - тоже, пока я якшаюсь с заказчиком - это мои проблемы, а после меня хоть потоп)

← →
Суслик © (2005-11-29 16:01) [20]

Они еще спрашивают!
А сами орехи суют :)

← →
Digitman © (2005-11-29 16:04) [21]

> Джо © (29.11.05 15:57) [17]

в том-то и дело, что не менял) ... до поры до времени ему просто везло и везет)

← →
Digitman © (2005-11-29 16:07) [22]

> pasha_golub © (29.11.05 15:56) [16]

таким образом автор сего чуда программерской мысли пытается идентифицировать класс некоего своего объекта, сравнивая со ссылками на записи о классах в RTTI

← →
Ega23 © (2005-11-29 16:07) [23]

> Они еще спрашивают!
> А сами орехи суют :)

В смысле, а где гарантия, что указатель только по этим четырём адресам будет?
Или всё-таки, шансы высоки?

← →
Суслик © (2005-11-29 16:09) [24]

это может быть одно из средств защиты своего приложения :)
грубое, но все же.

← →
Суслик © (2005-11-29 16:10) [25]

> В смысле, а где гарантия, что указатель только по этим четырём
> адресам будет?
> Или всё-таки, шансы высоки?

насколько я понимаю они грузятся в rtl.
Наверно (не проверял) можно заставить грузиться ее по одному адресу.

← →
Суслик © (2005-11-29 16:10) [26]

← →
msguns © (2005-11-29 16:11) [27]

>Ega23 © (29.11.05 15:57) [18]
>А как оно работает????

А никак. В смысле then никогда не наступает ;)

← →
pasha_golub © (2005-11-29 16:11) [28]

> Суслик © (29.11.05 16:09) [24]
>
> это может быть одно из средств защиты своего приложения
> :)
> грубое, но все же.
>

Я тоже об этом подумал, но это пипец конечно :0)

Пипец, конечно. Зато поддерживать твоею же программу будут звать всегда тебя.

> msguns © (29.11.05 16:11) [27]

ну почему же ?

наступает) ... до той поры пока rtl от сеанса к сеансу грузится по одному и тому же (ожидаемому автором шедевра) адресу ... или до той поры пока версия rtl та же что и у автора ... тут удивительно другое - как у заказчика до сих пор это ружьё не выстрелило)

Nikolay M. © (29.11.05 15:25) [4]
я даже могу сказать откуда этот код взялся у Валика. Ему он достался от дяди Борланда. см SysUtils.pas

По теме вот такой код видел:

raise TSomeException.Create(XXX);
DoSomething;

Сергей, это адназначат защита :)

вот еще один образчик на ту же тему из того же юнита того же шедевротворца :
(то что фигурирует под Digitman, было ненавязчиво предложено автору мной как солюшн, избавляющий от геморроя, с чем он подозрительно быстро согласился, сославшись на "не было времени переделать этот код как положено")

{$IFDEF Digitman}
function IsInterface(obj: Pointer; const aGUID: TGUID): Boolean;
var
Intf: IInterface;
begin
Result := False;
if Assigned(obj) then
try
Result := IUnknown(obj).QueryInterface(aGUID, Intf) = 0;
except
end;
end;
{$ENDIF}

..

if
{$IFDEF Digitman}
IsInterface(Pointer(obj), IXMLNode)
{$ELSE}
(tp=TClass($561A66)) or (tp=TClass($4fcd6a)) or (tp=TClass($4fcd76)) or (tp=TClass($50540A))
or (tp=TClass($503ee2)) or (tp=TClass($503f5e)) or (tp=TClass($5B081A)) or (tp=TClass($504ACE))
or (tp=TClass($503F82)) or (tp=TClass($503F72)) or (tp=TClass($504AB6)) or (tp=TClass($504B3E))
{$ENDIF}
then begin
tnode:=ixmlnode(pointer(obj));
with tnode.childnodes do for i1:=0 to count-1 do
process(pointer(nodes[i1]),adv1,adv2);
end else

if
{$IFDEF Digitman}
IsInterface(Pointer(obj), ihtmlelement)
{$ELSE}
(tp=TClass($7C509300)) or (tp=TClass($7D73E190)) or (tp=TClass($7D73C270))
or (tp=TClass($775e98d8))
{$ENDIF}
then begin
hnode:=ihtmlelement(pointer(obj));

....

а защитой тут и не пахнет) ... тут дурью отдает изрядно)

> raise TSomeException.Create(XXX);
> DoSomething;

Своего рода, как бы так выразиться, far exit? :)
Выход из нескольких процедур? :)

> Наверно (не проверял) можно заставить грузиться ее по одному
> адресу.

Вот если можно заставить грузиться по одному адресу, то действительно как средство защиты можно рассматривать. Тогда всё понятно.
Только я первый раз про такое слышу.
Собственно, поэтому и спросил...

Да это я предположил только :)

> Вот если можно заставить грузиться по одному адресу, то
> действительно как средство защиты можно рассматривать. Тогда
> всё понятно.
> Только я первый раз про такое слышу.
> Собственно, поэтому и спросил...

В принципе каждый модуль (в том числе и .exe) имеет заданный в PE файле базовый адрес. И при расположении сегментов модуля этот базовый адрес используется как точка отсчёта. Можно ли этот факт использовать для защиты - ХЗ.

Вот же блин!

// Возвращает строку из символов Char длиной Count. // Одно название модуля говорит за себя! // Модуль назвается SoStrUtils. function Chars(C: Char; Count: Integer): string; var Index: LongInt; begin Result := EmptyStr; for Index := 1 to Count do Result := Result + C; end;

> function IsInterface(obj: Pointer; const aGUID: TGUID):
> Boolean;
> var
> Intf: IInterface;
> begin
> Result := False;
> if Assigned(obj) then
> try
> Result := IUnknown(obj).QueryInterface(aGUID, Intf)
> = 0;
> except
> end;
> end;

имхо тоже так себе метод - невесть какая порча памяти теоретически может быть при вызове метода у неизвестно чего.

Суслик © (29.11.05 16:43) [39]
Ну в общем то да. И такое было
var p: pointer; begin ... try f := TObject(P) is TSomeObject; except f := False; end; if f then ... end;
Хотя вероятность некоректных действий тут практически нулевая, но тем не менее..

Примеры кода, достойные орехов. Найти похожие ветки